C                  *          *        *                                  A   1
C        GREMEX  V.3                                                      A   2
C      MAJOR REVISION OF  1975                                            A   3
C          A- ACTION CODES EXPANDED TO INCLUDE NEW ROUTINES               A   4
C          B- MOST TERMINATING ERRORS OF VERS.1 CHANGED TO NONTERM.       A   5
C          C- CONTRACTS MUST BE FUNDED BY PLAYER ACTIONS                  A   6
C          D- WORK WILL FREEZE WHEN FUNDS OUT                             A   7
C          E- '99' ON PLAYER'S PERIOD CARD WILL PRODUCE A 3 MONTH UPDATE  A   8
C                  *          *        *                                  A   9
      COMMON MONS(12)                                                     A  10
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  A  11
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     A  12
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  A  13
     1A,KC                                                                A  14
C                                                                         A  15
C     INITIALIZE COUNTERS                                                 A  16
C                                                                         A  17
      NPLRS=0                                                             A  18
      NCOM(18)=5                                                          A  19
      CALL EXEC1                                                          A  20
      RETURN                                                              A  21
      END                                                                 A  22-
      SUBROUTINE EXEC1                                                    B   1
C      CHANGES MADE BY R. WALES 12/12/73                                  B   2
      COMMON MONS(12)                                                     B   3
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  B   4
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     B   5
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  B   6
     1A,KC                                                                B   7
C                                                                         B   8
C     COUNT PLAYER, CHECK FOR STOP                                        B   9
C                                                                         B  10
  110 NPLRS=NPLRS+1                                                       B  11
      IF (NPLRS.GT.NCOM(18)) GO TO 130                                    B  12
C                                                                         B  13
C     CYCLE THRU INPUT ALLINEMENT, ACTION PROCESSING, PARAMETER CALCS     B  14
C      AND OUTPUT ROUTINES FOR EACH PLAYER.'NO'IS NOT IN COMMON,THERE-    B  15
C      FORE PASSED                                                        B  16
C                                                                         B  17
C      PUT EXEC2 HERE FOR LARGER CORE MACHINES                            B  18
  120 CALL EXEC2                                                          B  19
      IF (NCOM(9).EQ.2) GO TO 110                                         B  20
C      END OF EXEC2 AREA                                                  B  21
      CALL REPGEN                                                         B  22
      GO TO 110                                                           B  23
  130 BACKSPACE 10                                                        B  24
      BACKSPACE 10                                                        B  25
      BACKSPACE 10                                                        B  26
      GO TO 120                                                           B  27
      END                                                                 B  28-
      SUBROUTINE EXEC2                                                    C   1
C     EXEC2 (AND COMMON/LOCAL) USED WITH OVERLAYS FOR ACTION, PLAY, AND   C   2
C     FORWAR PHASES                                                       C   3
      COMMON MONS(12)                                                     C   4
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  C   5
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     C   6
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  C   7
     1A,KC                                                                C   8
  110 CALL PLAY (NO)                                                      C   9
C     NCOM(9)=ERROR STATUS                                                C  10
      IF (NCOM(9).EQ.2) GO TO 120                                         C  11
      CALL ACTION (NO)                                                    C  12
      NCOM(22)=1                                                          C  13
      IF (NPLRS.GT.NCOM(18)) GO TO 130                                    C  14
      IF (NCOM(9).EQ.2) GO TO 120                                         C  15
      CALL FORWAR                                                         C  16
  120 RETURN                                                              C  17
C      BACKSPACE TAPE TO REENTER PLAY FOR TERMINATOR CHECK                C  18
  130 BACKSPACE 10                                                        C  19
      BACKSPACE 10                                                        C  20
      BACKSPACE 10                                                        C  21
      GO TO 110                                                           C  22
      END                                                                 C  23-
      SUBROUTINE PLAY (NO)                                                D   1
C      CHANGES MADE BY R. WALES 12/12/73                                  D   2
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  D   3
     1                                                                    D   4
      DIMENSION ACTN(16,120)                                              D   5
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        D   6
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  D   7
     120),NAC(5,120)                                                      D   8
      COMMON MONS(12)                                                     D   9
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  D  10
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     D  11
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  D  12
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                D  13
      INTEGER*2 NHOLD,NO,I                                                D  14
C                                                                         D  15
C                                                                         D  16
C     READ LAST PERIOD DATA FOR A PLAYER                                  D  17
C                                                                         D  18
  110 READ (10) NACTIV                                                    D  19
      READ (10) IPERB,NCOMP,NTRACT,NACTN,NDIST,NCOM,NREP,MONS,NDAYS,NDAT  D  20
     1E                                                                   D  21
      READ (10) NCPDAT                                                    D  22
C     NCOM(18) = 5                                                        D  23
C     RESET ERROR FLAG                                                    D  24
      NCOM(9)=0                                                           D  25
C                                                                         D  26
C     PRINT OUT PLAYER - PERIOD HEADING                                   D  27
C                                                                         D  28
      NHOLD=NCOM(8)+1                                                     D  29
      WRITE (6,250) NCOM(6),NHOLD                                         D  30
C      ***************************************************************    D  31
C     READ FIRST CARD OF PLAYER'S INPUT                                   D  32
C      ***************************************************************    D  33
C                                                                         D  34
  120 READ (5,240) NO,(IN(I),I=1,9),ISCHDM,IN(11),IN(12),ISTRDM,(IN(I),I  D  35
     1=14,22)                                                             D  36
      WRITE (6,270) NO,(IN(I),I=1,9),ISCHDM,IN(11),IN(12),ISTRDM,(IN(I),  D  37
     1I=14,22)                                                            D  38
C     RESET INPUT DECK TERMINATOR                                         D  39
      NCOM(22)=0                                                          D  40
C                                                                         D  41
C     SEE IF END OF ALL INPUT CARDS                                       D  42
C                                                                         D  43
C     CHECK FOR TERMINATOR                                                D  44
      IF (NO.GT.3) GO TO 230                                              D  45
      NHOLD=NO+1                                                          D  46
      GO TO (140,130,180,180), NHOLD                                      D  47
  130 CALL ERROR2 (1,1,1)                                                 D  48
      GO TO 160                                                           D  49
C                                                                         D  50
C     PLAYER NBRS ALLINED, RETURN                                         D  51
C                                                                         D  52
  140 IF (IN(17).EQ.NCOM(6)) RETURN                                       D  53
C                                                                         D  54
C     CHECK FOR ILLEGAL PLAYER NUMBER                                     D  55
      IF (IN(17).GT.NCOM(18)) GO TO 150                                   D  56
C     INPUT PLAYER NBR < PROCESSING PLAYER NBR, CARDS OUT OF SEQUENCE     D  57
C      SINCE CARDS LAG BEHIND TAPE.                                       D  58
C                                                                         D  59
      IF (IN(17).LT.NCOM(6)) GO TO 150                                    D  60
C                                                                         D  61
C     CARD INPUT PLAYER NBR > PROCESSING PLAYER NBR, NO INPUT FOR SOME    D  62
C      PLAYER(5), MOVE PROCESSING TAPE UP TO CARD PLAYER NBR.             D  63
C                                                                         D  64
      NPASS=IN(17)                                                        D  65
      CALL ERROR2 (1,1,NPASS)                                             D  66
      WRITE (11) NACTIV                                                   D  67
      WRITE (11) IPERB,NCOMP,NTRACT,NACTN,NDIST,NCOM,NREP,MONS,NDAYS,NDA  D  68
     1TE                                                                  D  69
      WRITE (11) NCPDAT                                                   D  70
      NPLRS=NPLRS+1                                                       D  71
      IF (NPLRS.GT.NCOM(18)) GO TO 190                                    D  72
      READ (10) NACTIV                                                    D  73
      READ (10) IPERB,NCOMP,NTRACT,NACTN,NDIST,NCOM,NREP,MONS,NDAYS,NDAT  D  74
     1E                                                                   D  75
      READ (10) NCPDAT                                                    D  76
C                                                                         D  77
C     NO INPUT FOR THIS PLAYER THIS PERIOD (LAST PERIOD NBR + 1)          D  78
C                                                                         D  79
      NHOLD=NCOM(8)+1                                                     D  80
      WRITE (6,250) NCOM(6),NHOLD                                         D  81
      GO TO 140                                                           D  82
  150 NPASS=IN(17)                                                        D  83
      CALL ERROR2 (2,2,NPASS)                                             D  84
C                                                                         D  85
C     SKIP CARDS UNTIL NEXT INPUT PLAYER DECK                             D  86
C                                                                         D  87
  160 READ (5,240) NO,(IN(I),I=1,9),ISCHDM,IN(11),IN(12),ISTRDM,(IN(I),I  D  88
     1=14,22)                                                             D  89
      IF (NO.GT.3) GO TO 230                                              D  90
      NHOLD=NO+1                                                          D  91
      GO TO (160,120,170,170), NHOLD                                      D  92
C                                                                         D  93
C     NO INPUT FOR REMAINING PLAYERS. 2 NOT READ WHEN NBR INPUTS= NBR     D  94
C       PLAYERS                                                           D  95
C                                                                         D  96
  170 WRITE (6,270) NO,(IN(I),I=1,9),ISCHDM,IN(11),IN(12),ISTRDM,(IN(I),  D  97
     1I=14,22)                                                            D  98
  180 NPASS=IN(17)                                                        D  99
      CALL ERROR2 (1,3,NPASS)                                             D 100
      WRITE (11) NACTIV                                                   D 101
      WRITE (11) IPERB,NCOMP,NTRACT,NACTN,NDIST,NCOM,NREP,MONS,NDAYS,NDA  D 102
     1TE                                                                  D 103
      WRITE (11) NCPDAT                                                   D 104
      NPLRS=NPLRS+1                                                       D 105
      IF (NPLRS.GT.NCOM(18)) GO TO 200                                    D 106
      READ (10) NACTIV                                                    D 107
      READ (10) IPERB,NCOMP,NTRACT,NACTN,NDIST,NCOM,NREP,MONS,NDAYS,NDAT  D 108
     1E                                                                   D 109
      READ (10) NCPDAT                                                    D 110
      NHOLD=NCOM(8)+1                                                     D 111
      WRITE (6,250) NCOM(6),NHOLD                                         D 112
      GO TO 180                                                           D 113
  190 READ (5,240) NO                                                     D 114
C      BACK UP PLAYER COUNTER TO FINAL VALUE                              D 115
  200 NPLRS=NCOM(18)                                                      D 116
  210 END FILE 11                                                         D 117
      REWIND 10                                                           D 118
      REWIND 11                                                           D 119
      IF (NO.NE.3) STOP                                                   D 120
C      ABOVE IS NORMAL END OF JOB POINT                                   D 121
C      IF TERMINATOR #3 ANOTHER MONTHS INPUT DATA FOLLOWS                 D 122
C     NOW COPY LAST OUTPUT TO INPUT UNIT                                  D 123
C     THIS IS TO SAVE HAVING TO CHANGE LUN'S THROUGHOUT THE PROGRAM       D 124
      DO 220 I=1,NPLRS                                                    D 125
      READ (11) NACTIV                                                    D 126
      WRITE (10) NACTIV                                                   D 127
      READ (11) IPERB,NCOMP,NTRACT,NACTN,NDIST,NCOM,NREP,MONS,NDAYS,NDAT  D 128
     1E                                                                   D 129
      WRITE (10) IPERB,NCOMP,NTRACT,NACTN,NDIST,NCOM,NREP,MONS,NDAYS,NDA  D 130
     1TE                                                                  D 131
      READ (11) NCPDAT                                                    D 132
      WRITE (10) NCPDAT                                                   D 133
      WRITE (6,280) NCOM(6),NCOM(8)                                       D 134
  220 CONTINUE                                                            D 135
      END FILE 10                                                         D 136
C     NOW GO BACK TO THE START OF THE TAPES                               D 137
      REWIND 10                                                           D 138
      REWIND 11                                                           D 139
      NPLRS=1                                                             D 140
      GO TO 110                                                           D 141
C     BAD DATA IN TERMINATOR FIELD                                        D 142
  230 WRITE (6,260)                                                       D 143
      GO TO 210                                                           D 144
C                                                                         D 145
  240 FORMAT (I1,3I3,I2,2I1,I2,I3,I2,A3,2I2,A3,I2,2X,I4,3I2,2I4,I2,1X,I4  D 146
     1)                                                                   D 147
  250 FORMAT (28H1      LIST FOR FILE PLAYER I2,8H PERIOD I2)             D 148
  260 FORMAT ('  BAD TERMINATOR DATA - STOP')                             D 149
  270 FORMAT (14H0INPUT CARD   ,I1,4I5,2I2,I4,1X,I4,I4,1X,A3,I3,I4,1X,A3  D 150
     1,I3,4X,I6,3I4,2X,I4,2X,I4,I4,2X,I4)                                 D 151
  280 FORMAT (//,' FILE FOR PLAYER',I3,' PERIOD,',I2,' COPIED TO ','INPU  D 152
     1T TAPE.')                                                           D 153
      END                                                                 D 154-
      SUBROUTINE DTCONV (IN1,IN2,IN3,NDT)                                 E   1
C     DTCONV CONVERTS THE CURRENT DATE (DAY = IN1, MONTH = IN2, AND       E   2
C            YEAR = IN3) INTO TENTHS OF WEEKS SINCE THE BEGINNING OF      E   3
C            THE CONTRACT, AND PLACES THE VALUE INTO NDT.                 E   4
C                                                                         E   5
C                                                                         E   6
      COMMON MONS(12)                                                     E   7
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  E   8
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     E   9
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  E  10
     1A,KC                                                                E  11
      DIMENSION NTCON(24)                                                 E  12
      INTEGER*2 IN1,IN3,NDT,I                                             E  13
      DATA NTCON/3HJAN,3HFEB,3HMAR,3HAPR,3HMAY,3HJUN,3HJUL,3HAUG,3HSEP,3  E  14
     1HOCT,3HNOV,3HDEC,0,443,843,1286,1715,2158,2587,3030,3473,3902,4345  E  15
     2,4774/                                                              E  16
C                                                                         E  17
C                                                                         E  18
C     MATCH ON MONTH, ADD 12 TO GET CORRES NBR WKS FROM BEGINING OF THE   E  19
C            YEAR IN HUNDREDTHS.                                          E  20
C                                                                         E  21
      DO 110 I=1,12                                                       E  22
      IF (IN2.NE.NTCON(I)) GO TO 110                                      E  23
C                                                                         E  24
C     CONVERT PRESENT DATE TO HUNDREDTHS OF WEEKS, ADD NBR OF HUNDREDTHS  E  25
C            OF WEEKS FROM BEGIN OF YEAR, ADD NBR YRS FROM CONTRACT YEAR  E  26
C            *HUNDREDTHS OF WK IN A YR, SUBTRACT 10*NBR WK FROM BEGIN OF  E  27
C            CONTRACT YR TO CONTRACT DATE IN TENTHS(NOTE THAT CONTRACT    E  28
C            DATE MUST BE THE LAST DAY OF THE MONTH), ROUND THE TOTAL     E  29
C            AND CONVERT TO TENTHS(CALCULATION IN HUNDREDTHS) PUT IN NTD  E  30
C                                                                         E  31
      NDT=(((100*IN1)/7+NTCON(I+12)+5217*(IN3-NCOM(11))-10*NCOM(10))+5)/  E  32
     110                                                                  E  33
      RETURN                                                              E  34
  110 CONTINUE                                                            E  35
      WRITE (6,120)                                                       E  36
      NDT=NCOM(10)                                                        E  37
      RETURN                                                              E  38
C                                                                         E  39
  120 FORMAT (16H0 BAD DATE PUNCH)                                        E  40
      END                                                                 E  41-
      SUBROUTINE FORWAR                                                   F   1
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  F   2
     1                                                                    F   3
      DIMENSION NSORT(999)                                                F   4
      DIMENSION ACTN(16,120)                                              F   5
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        F   6
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  F   7
     120),NAC(5,120)                                                      F   8
      COMMON MONS(12)                                                     F   9
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  F  10
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     F  11
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  F  12
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                F  13
      INTEGER*2 LTIME                                                     F  14
      INTEGER*2 I,IJ,I1,II,I11,III,ICNT,ICOMP,IC,IF,IBACK,J,J1,JJ,K,KSTR  F  15
     1T,L,LL,LGTE,M,MBIT,MAXC,MCONST,NSUM,NSTOP,NSTRT,NP,NYR,NCONST,NALP  F  16
     2HA,NRND,NOACT,NTMAX,NCTR,NTIME,NFREEZ,NRIA,NCTN,NC,NBIT,NDUM1,NDUM  F  17
     32,NDUM3,NTD,NTE,NUT,NDIFF,NTBL,NTBE,NSMTBE,NX,NY,NZ,NK,MPASS,NDY,M  F  18
     4Q                                                                   F  19
      DIMENSION SP(22)                                                    F  20
      DIMENSION TBL(13)                                                   F  21
      INTEGER*2 TBL                                                       F  22
      DATA TBL/443,400,443,429,443,429,443,443,429,443,429,443,0/         F  23
      DATA IYES/'YES'/,IBLK/'   '/                                        F  24
      EQUIVALENCE (PAT,NPAT), (PAC,NPAC), (PAR,NPAR)                      F  25
      IKK=1                                                               F  26
      IF (NCOM(9).EQ.0) WRITE (6,1460)                                    F  27
C     NCTR = NBR OF CONTRACTS                                             F  28
      NCTR=NCOM(4)                                                        F  29
C     SET INPUT DECK TERMINATOR                                           F  30
      NCOM(22)=1                                                          F  31
C     PROJECT NOT INITIALIZED ?                                           F  32
      IF (NCOM(21).EQ.0) GO TO 1450                                       F  33
C     SET UP TO FIND NUMBER OF WEEKS SINCE ORIGIN OF PROJECT              F  34
      K=NCOM(21)                                                          F  35
      NDY=NDATE(K)                                                        F  36
      NL=MONS(K)                                                          F  37
      NYR=NCOM(20)                                                        F  38
      CALL DTCONV (NDY,NL,NYR,NTIME)                                      F  39
C      ALSO FIND NUMBER OF WEEKS TO START OF CURRENT PERIOD               F  40
      K=NCOM(21)-NCOM(17)                                                 F  41
      IF (K.GT.0) GO TO 110                                               F  42
      K=K+12                                                              F  43
      NYR=NCOM(20)-1                                                      F  44
  110 NDY=NDATE(K)                                                        F  45
      NL=MONS(K)                                                          F  46
      CALL DTCONV (NDY,NL,NYR,LTIME)                                      F  47
C      ***************************************************************    F  48
C     BEGIN FORWARD PASS                                                  F  49
C      ***************************************************************    F  50
C     INITIALIZE GREATEST EXPECTED COMPLETION(FOR PROJECT)                F  51
      LGTE=0                                                              F  52
C     ESTABLISH COMPONENT TIME,COST,RELIABILITY,PROBABILITY(S)(LAST) AND  F  53
C     EXPECTED COMPLETION TIME(LAST) FROM CORRESPONDING NOW VALUES AND    F  54
C     INITIALIZE THE NOW VALUES. DO FOR ALL COMPONENTS.                   F  55
      NC=NCOM(3)                                                          F  56
      DO 130 J=1,NC                                                       F  57
      IF (NCOMP(37,J).EQ.0) GO TO 130                                     F  58
      DO 120 I=1,4                                                        F  59
      NCOMP(I+24,J)=NCOMP(I+33,J)                                         F  60
  120 NCOMP(I+33,J)=0                                                     F  61
  130 CONTINUE                                                            F  62
C     *********                                                           F  63
C          FUNDING CHECK                                                  F  64
C      IF INSUFFICIENT FUNDS,POSTPONE WORK TO END OF CURRENT PERIOD       F  65
C      *****                                                              F  66
      DO 160 I=1,NCTR                                                     F  67
      IF (NTRACT(13,I).EQ.0) GO TO 160                                    F  68
      IF (NTRACT(2,I).GE.NTIME) GO TO 160                                 F  69
      IF (11*NTRACT(10,I)/7.LT.NTRACT(4,I)-1) GO TO 160                   F  70
C      CONTRACT STARTED BY END THIS PERIOD,FIND  ACTIVITIES IN PROGRESS   F  71
      DO 150 IJ=1,N                                                       F  72
      IF (NACTIV(4,IJ).NE.NTRACT(1,I)) GO TO 150                          F  73
C      ACTIVITY NOT COMPLETED?                                            F  74
      CALL UNPAK (NBIT,13,IJ)                                             F  75
      IF (NBIT.LT.0) GO TO 150                                            F  76
C      STARTED ?                                                          F  77
      CALL UNPAK (NBIT,12,IJ)                                             F  78
      IF (NBIT.LT.0) GO TO 140                                            F  79
      CALL UNPAK (NBIT,16,IJ)                                             F  80
      IF (NBIT.GE.0) GO TO 150                                            F  81
  140 NACTIV(52,IJ)=NTIME+1                                               F  82
  150 CONTINUE                                                            F  83
  160 CONTINUE                                                            F  84
C      ACTIVATE PERBS WITHOUT CRITICAL ACTIVITIES                         F  85
      NP=NCOM(2)                                                          F  86
      DO 210 II=1,NP                                                      F  87
      IF (IPERB(21,II).NE.1) GO TO 210                                    F  88
      IF (IPERB(5,II).NE.0) GO TO 210                                     F  89
      IPERB(21,II)=0                                                      F  90
      DO 180 K=6,10                                                       F  91
      IF (IPERB(K,II).EQ.0) GO TO 190                                     F  92
      DO 170 J=1,N                                                        F  93
      IF (NACTIV(3,J).NE.IPERB(K,II)) GO TO 170                           F  94
      CALL PACK (0,15,J)                                                  F  95
      GO TO 180                                                           F  96
  170 CONTINUE                                                            F  97
  180 CONTINUE                                                            F  98
  190 DO 200 K=11,20                                                      F  99
      IF (IPERB(K,II).EQ.0) GO TO 210                                     F 100
      DO 200 J=1,N                                                        F 101
      IF (NACTIV(3,J).NE.IPERB(K,II)) GO TO 200                           F 102
      CALL PACK (1,15,J)                                                  F 103
      IF (K.NE.11) GO TO 200                                              F 104
      CALL UNPAK (NBIT,9,J)                                               F 105
      IF (NBIT.LT.0) CALL PACK (1,8,J)                                    F 106
  200 CONTINUE                                                            F 107
  210 CONTINUE                                                            F 108
C     **** FORWARD PASS ON ALL ACTIVITIES ********                        F 109
      WRITE (6,1470)                                                      F 110
      DO 800 IJ=1,N                                                       F 111
C     RESET JUST COMPLETED INDICATOR                                      F 112
      CALL PACK (0,6,IJ)                                                  F 113
C     EXISTANCE INDICATOR SET ?                                           F 114
      CALL UNPAK (NBIT,15,IJ)                                             F 115
      IF (NBIT.GE.0) GO TO 790                                            F 116
C     COMPLETION INDICATOR SET ?                                          F 117
      CALL UNPAK (NBIT,13,IJ)                                             F 118
      IF (NBIT.LT.0) GO TO 790                                            F 119
C     INITIALIZE SUM UT (NUT) AND PROB CHANGE AREA (SP(12))  WHERE:       F 120
C     SP(1)=SUM P(T),SP(4)=SUM Q(T),SP(7)=SUM S(T),SP(10)=NBR P(T) NE 0   F 121
C     SP(2)=SUM P(C),SP(5)=SUM Q(C),SPN8)=SUM S(C),SP(11)=NBR P(C) NE 0   F 122
C     SP(3)=SUM P(R),SP(6)=SUM Q(R),SP(9)=SUM S(R),SP(12)=NBR P(R) NE 0   F 123
      NUT=0                                                               F 124
      DO 220 II=1,12                                                      F 125
  220 SP(II)=0.0                                                          F 126
      II=NCOM(4)                                                          F 127
C     SET UP CONTRACT INDEX FOR ENTIRE FORWARD PASS                       F 128
      DO 230 I=1,II                                                       F 129
      NCTR=I                                                              F 130
      IF (NACTIV(4,IJ).NE.NTRACT(1,I)) GO TO 230                          F 131
      GO TO 260                                                           F 132
  230 CONTINUE                                                            F 133
      NPASS=NACTIV(4,IJ)                                                  F 134
      MQ=25                                                               F 135
C     ERROR ROUTINE                                                       F 136
      WRITE (6,1480) MQ,NPASS                                             F 137
      GO TO 800                                                           F 138
  240 WRITE (6,1490) NCTN,NACTIV(3,IJ)                                    F 139
      GO TO 290                                                           F 140
  250 WRITE (6,1500) (NAC(KK,I),KK=1,4)                                   F 141
      GO TO 350                                                           F 142
C     NBR ACTIONS AGAINST ACTIVITIES = 0 ? (AGAINST ALL ACTIVITIES)       F 143
  260 IF (KA.EQ.0) GO TO 300                                              F 144
      DO 290 I=1,KA                                                       F 145
      IF (NAA(2,I).NE.NACTIV(3,IJ)) GO TO 290                             F 146
      NCTN=NAA(1,I)                                                       F 147
      IF ((NCTN.LE.0).OR.(NCTN.GT.120)) GO TO 240                         F 148
      DO 270 II=1,9                                                       F 149
  270 SP(II)=SP(II)+ACTN(II+1,NCTN)                                       F 150
      DO 280 II=1,3                                                       F 151
      IF (ACTN(II+1,NCTN).NE.0.0) SP(II+9)=SP(II+9)+1.0                   F 152
  280 CONTINUE                                                            F 153
      NUT=NUT+NACTN(12,NCTN)                                              F 154
  290 CONTINUE                                                            F 155
C     NBR ACTIONS AGAINST COMPONENTS = 0?                                 F 156
  300 IF (KC.EQ.0) GO TO 360                                              F 157
C     ACTIONS AGAINST COMPONENTS EXIST, KC = NBR OF THEM. FOR MATCHING    F 158
C     COMPONENT NBR(CONTRACT,SYSTEM,SUBSYSTEM NBRS) OR FOR ENCOMPASSING   F 159
C     COMPONENT(COMPONENT INCLUDES ALL ACTIVITIES OF COMPONENTS BELOW     F 160
C     IT)(E.G. 110 INCLUDES 110 ACTIVITIES AND ACTIVITIES OF COMPONENTS   F 161
C     111 THRU 116),PERFORM SUMS OVER ACTION ATTRIBUTES AS ABOVE.         F 162
      DO 350 I=1,KC                                                       F 163
      IF (NAC(2,I).NE.NACTIV(4,IJ)) GO TO 350                             F 164
      IF (NAC(3,I).NE.NACTIV(5,IJ)) GO TO 310                             F 165
      IF (NAC(4,I).EQ.NACTIV(6,IJ)) GO TO 320                             F 166
      IF (NAC(4,I).EQ.0) GO TO 320                                        F 167
      GO TO 350                                                           F 168
  310 IF (NAC(3,I).EQ.0) GO TO 320                                        F 169
      GO TO 350                                                           F 170
  320 NCTN=NAC(1,I)                                                       F 171
      IF ((NCTN.LE.0).OR.(NCTN.GT.120)) GO TO 250                         F 172
      DO 330 II=1,9                                                       F 173
  330 SP(II)=SP(II)+ACTN(II+1,NCTN)                                       F 174
      DO 340 II=1,3                                                       F 175
      IF (ACTN(II+1,NCTN).NE.0.0) SP(II+9)=SP(II+9)+1.0                   F 176
  340 CONTINUE                                                            F 177
      NUT=NUT+NACTN(12,NCTN)                                              F 178
  350 CONTINUE                                                            F 179
  360 IF (SP(4).LT.-1.0) SP(4)=-1.0                                       F 180
      ACTWKA=NACTIV(38,IJ)/100.0                                          F 181
      IF (SP(1).EQ.0.0) GO TO 370                                         F 182
      SP(1)=SP(1)/SP(10)-.50                                              F 183
      IF (SP(1).LT.0.0) GO TO 370                                         F 184
      PAT=(1.0-ACTWKA)*ABS(SP(1))*(1.0+SP(4))+SP(7)+ACTWKA                F 185
      GO TO 380                                                           F 186
C     ACTIVITY P(T)       FOR DECREASING PROB EFFECTS  *****              F 187
  370 PAT=ACTWKA-(ACTWKA*ABS(SP(1))*(1.0-SP(4)))+SP(7)                    F 188
  380 IF (SP(5).LT.-1.0) SP(5)=-1.0                                       F 189
      ACTWKA=NACTIV(39,IJ)/100.0                                          F 190
      IF (SP(2).EQ.0.0) GO TO 390                                         F 191
      SP(2)=SP(2)/SP(11)-.50                                              F 192
      IF (SP(2).LT.0.0) GO TO 390                                         F 193
      PAC=(1.0-ACTWKA)*ABS(SP(2))*(1.0+SP(5))+SP(8)+ACTWKA                F 194
      GO TO 400                                                           F 195
  390 PAC=ACTWKA-(ACTWKA*ABS(SP(2))*(1.0-SP(5)))+SP(8)                    F 196
  400 IF (SP(6).LT.-1.0) SP(6)=-1.0                                       F 197
      ACTWKA=NACTIV(40,IJ)/100.0                                          F 198
      IF (SP(3).EQ.0.0) GO TO 410                                         F 199
      SP(3)=SP(3)/SP(12)-.50                                              F 200
      IF (SP(3).LT.0.0) GO TO 410                                         F 201
      PAR=(1.0-ACTWKA)*ABS(SP(3))*(1.0+SP(6))+SP(9)+ACTWKA                F 202
      GO TO 420                                                           F 203
  410 PAR=ACTWKA-(ACTWKA*ABS(SP(3))*(1.0-SP(6)))+SP(9)                    F 204
  420 NPAR=100.*PAR+0.9                                                   F 205
      IF (NPAR.LT.1) NPAR=1                                               F 206
      IF (NPAR.GT.99) NPAR=99                                             F 207
      NPAC=100.*PAC+0.9                                                   F 208
      IF (NPAC.LT.1) NPAC=1                                               F 209
      IF (NPAC.GT.99) NPAC=99                                             F 210
      NPAT=100.*PAT+0.9                                                   F 211
      IF (NPAT.LT.1) NPAT=1                                               F 212
      IF (NPAT.GT.99) NPAT=99                                             F 213
      IF (NACTIV(10,IJ).EQ.0) NACTIV(10,IJ)=100                           F 214
      NRIA=NACTIV(10,IJ)*NPAR/100                                         F 215
      IF (NRIA.GE.36) GO TO 440                                           F 216
      IF (NRIA.LT.4) GO TO 430                                            F 217
      M=50                                                                F 218
      GO TO 460                                                           F 219
  430 M=100                                                               F 220
      GO TO 460                                                           F 221
  440 IF (NRIA.LT.60) GO TO 450                                           F 222
      M=7                                                                 F 223
      GO TO 460                                                           F 224
  450 M=33                                                                F 225
  460 IF (NRIA.GT.(NOMEGA/100)) M=0                                       F 226
C     ADJUST NUT IF WORK PARTIALLY COMPLETE                               F 227
      IF (NUT.EQ.0) GO TO 470                                             F 228
C     COMPARE START DATE WITH THAT OF CURRENT MONTH                       F 229
      NDUM1=NACTIV(42,IJ)-NACTIV(41,IJ)-LTIME                             F 230
      IF (NDUM1.LT.0) NUT=NUT*(NACTIV(41,IJ)+NDUM1)/NACTIV(41,IJ)         F 231
  470 CONTINUE                                                            F 232
      L=NACTIV(38,IJ)                                                     F 233
      IF (L.LT.1) L=1                                                     F 234
      IF (L.GT.99) L=99                                                   F 235
C     CALCULATE NDIFF = TOTAL FAILURE PENALTY (NORMALIZED) = M - ANY      F 236
C      NORMALIZED INCREASE OF P(T) OR M + ANY NORMALIZED DECREASE P(T).   F 237
      NDIFF=M-(NDIST(NPAT)-NDIST(L))                                      F 238
C     IF FAILED PREVIOUS PERIOD MAKE NO MORE CHANGES                      F 239
      CALL UNPAK (NBIT,8,IJ)                                              F 240
      IF (NBIT.LT.0) GO TO 480                                            F 241
C     SEE IF TEST ACTIVITY AND IF STARTED                                 F 242
      CALL UNPAK (NBIT,9,IJ)                                              F 243
      CALL UNPAK (MBIT,12,IJ)                                             F 244
C     SEE IF TEST ACTIVITY FAILS                                          F 245
      IF (M.NE.50.AND.M.NE.100) GO TO 480                                 F 246
      IF (NBIT.LT.0.AND.NPAT.LT.60.AND.MBIT.LT.0) GO TO 490               F 247
  480 NACTIV(51,IJ)=1                                                     F 248
      GO TO 500                                                           F 249
C     TEST ACTIVITY FAILS,DOUBLE TEST ACTIVITY TIME                       F 250
  490 NDIFF=1                                                             F 251
      NPAT=90                                                             F 252
      NPAR=90                                                             F 253
      NACTIV(51,IJ)=2                                                     F 254
      CALL PACK (1,8,IJ)                                                  F 255
  500 NTD=((100*NACTIV(41,IJ)+NUT*NACTIV(41,IJ)+NDIFF*NACTIV(8,IJ))/100)  F 256
     1*NACTIV(51,IJ)+NACTIV(53,IJ)*10                                     F 257
C      MAX TIME FOR ACTIVITY LIMITED TO 1 YEAR                            F 258
C      IF ZERO OR NEG SET TO 1/3 BASE VALUE                               F 259
      IF (NTD.GE.520) NTD=520                                             F 260
      IF (NTD.GE.0) GO TO 510                                             F 261
      NTD=NACTIV(15,IJ)/3                                                 F 262
  510 I1=IJ-1                                                             F 263
C     START DATE TESTS AND USAGE                                          F 264
      NTMAX=0                                                             F 265
C     SEE IF ACTIVITY START DATE SET                                      F 266
      IF (NACTIV(52,IJ).EQ.0) GO TO 520                                   F 267
      IHOLD=NACTIV(52,IJ)                                                 F 268
      NTMAX=IABS(IHOLD)                                                   F 269
      GO TO 580                                                           F 270
C     SEE IF INITIAL ACTIVITY?                                            F 271
  520 CALL UNPAK (NBIT,16,IJ)                                             F 272
      IF (NBIT.GE.0) GO TO 540                                            F 273
C     YES                                                                 F 274
      CALL UNPAK (NBIT,7,IJ)                                              F 275
      IF (NBIT.LT.0) GO TO 530                                            F 276
C     BUT COMPONENT START DATE NOT SET SO START NOW                       F 277
      NTMAX=NTIME                                                         F 278
      GO TO 560                                                           F 279
C     COMP HAS START DATE, GET IT, SET NTMAX = COMP START DATE            F 280
  530 NX=NACTIV(4,IJ)                                                     F 281
      NY=NACTIV(5,IJ)                                                     F 282
      NZ=NACTIV(6,IJ)                                                     F 283
      CALL CSRCH (NX,NY,NZ,ICOMP)                                         F 284
      IF (ICOMP.EQ.0) GO TO 560                                           F 285
      NTMAX=NCOMP(48,ICOMP)                                               F 286
      GO TO 560                                                           F 287
  540 MQ=0                                                                F 288
C     SEARCH PREVIOUS ACTIVITIES                                          F 289
      DO 550 I11=1,I1                                                     F 290
      CALL UNPAK (NBIT,15,I11)                                            F 291
      IF (NBIT.GE.0) GO TO 550                                            F 292
      IF (NACTIV(2,I11).NE.NACTIV(1,IJ)) GO TO 550                        F 293
      MQ=1                                                                F 294
      IF (NACTIV(42,I11).GT.NTMAX) NTMAX=NACTIV(42,I11)                   F 295
  550 CONTINUE                                                            F 296
C     IF NO PREDECESSOR, DON'T START THIS PERIOD                          F 297
      IF (MQ.EQ.0) NTMAX=NTIME+50*NCOM(17)                                F 298
C     SET START FOR PERTURBATIONS                                         F 299
  560 CALL UNPAK (NBIT,11,IJ)                                             F 300
      IF (NBIT.GE.0) GO TO 580                                            F 301
      CALL UNPAK (NBIT,7,IJ)                                              F 302
      IF (NBIT.LT.0) GO TO 570                                            F 303
      IF (NTIME.GT.NTMAX) NTMAX=NTIME                                     F 304
      GO TO 590                                                           F 305
C     START DATE IND SET NTMAX = COMPONENT START DATE                     F 306
  570 NX=NACTIV(4,IJ)                                                     F 307
      NY=NACTIV(5,IJ)                                                     F 308
      NZ=NACTIV(6,IJ)                                                     F 309
      CALL CSRCH (NX,NY,NZ,ICOMP)                                         F 310
      IF (ICOMP.EQ.0) GO TO 580                                           F 311
      IF (NCOMP(48,ICOMP).GT.NTMAX) NTMAX=NCOMP(48,ICOMP)                 F 312
  580 CONTINUE                                                            F 313
  590 NTE=NTD+NTMAX                                                       F 314
C      MAX TIMES FOR PROJECT LIMITED TO 5 YEARS                           F 315
      IF (NTE.LE.2600) GO TO 600                                          F 316
      NTE=2600                                                            F 317
  600 NP=NCOM(2)                                                          F 318
      DO 610 II=1,NP                                                      F 319
C     IF CRITICAL ACTIVITY IS 0 THEN ACTIVATE PERB                        F 320
      IF (IPERB(21,II).NE.1) GO TO 610                                    F 321
      IF (IPERB(5,II).EQ.0) GO TO 610                                     F 322
      CALL ASRCH (II,K)                                                   F 323
      IF (K.EQ.0) GO TO 620                                               F 324
      IF (NACTIV(1,K).EQ.NACTIV(2,IJ)) GO TO 660                          F 325
  610 CONTINUE                                                            F 326
      GO TO 730                                                           F 327
C     ERROR ROUTINE FOR PERBS.                                            F 328
  620 MQ=14                                                               F 329
      NPASS=II                                                            F 330
      GO TO 650                                                           F 331
  630 MQ=12                                                               F 332
      GO TO 650                                                           F 333
  640 MQ=11                                                               F 334
  650 WRITE (6,1480) MQ,NPASS                                             F 335
      GO TO 730                                                           F 336
  660 IF (NTIME.LT.NTE) GO TO 740                                         F 337
C     THIS CHECK IS TO INSURE THAT ALL OTHER ACTIVITIES ARE COMPLETE.     F 338
      DO 670 I11=1,N                                                      F 339
      CALL UNPAK (NBIT,13,I11)                                            F 340
      IF (NACTIV(1,K).EQ.NACTIV(2,I11).AND.NBIT.GE.0.AND.I11.NE.IJ) GO T  F 341
     1O 730                                                               F 342
  670 CONTINUE                                                            F 343
      IPERB(21,II)=0                                                      F 344
      DO 690 K=6,10                                                       F 345
      IF (IPERB(K,II).EQ.0) GO TO 700                                     F 346
      NOACT=NCOM(1)                                                       F 347
      DO 680 J=1,NOACT                                                    F 348
      IF (NACTIV(3,J).NE.IPERB(K,II)) GO TO 680                           F 349
      CALL PACK (0,15,J)                                                  F 350
      GO TO 690                                                           F 351
  680 CONTINUE                                                            F 352
      NPASS=IPERB(K,II)                                                   F 353
      GO TO 640                                                           F 354
  690 CONTINUE                                                            F 355
  700 DO 720 K=11,20                                                      F 356
      IF (IPERB(K,II).EQ.0) GO TO 730                                     F 357
      DO 710 J=1,NOACT                                                    F 358
      IF (NACTIV(3,J).NE.IPERB(K,II)) GO TO 710                           F 359
      CALL PACK (1,15,J)                                                  F 360
C      IF FIRST NEW ACTIVITY IS A TEST ACTIVITY,SET TO PRINT ON TECH NAR  F 361
      CALL UNPAK (NBIT,9,J)                                               F 362
      IF ((K.EQ.11).AND.(NBIT.LT.0)) CALL PACK (1,8,J)                    F 363
      GO TO 720                                                           F 364
  710 CONTINUE                                                            F 365
      NPASS=IPERB(K,II)                                                   F 366
      GO TO 630                                                           F 367
  720 CONTINUE                                                            F 368
C     SEE IF ACTIVITY COMPLETED, IF SO, SET COMPLETED, JUST COMPLETED IN  F 369
  730 IF (NTIME.LT.NTE) GO TO 740                                         F 370
      CALL PACK (1,13,IJ)                                                 F 371
      CALL PACK (1,6,IJ)                                                  F 372
C     INCREASE RELIABILITY FOR COMPLETED ACTIVITY                         F 373
      NPAR=NPAR+(100-NPAR)/2                                              F 374
  740 IF (NTE.GT.LGTE) LGTE=NTE                                           F 375
      IF (NTMAX.LT.NTIME) CALL PACK (1,12,IJ)                             F 376
      NC=NCOM(3)                                                          F 377
      DO 770 II=1,NC                                                      F 378
      IF (NCOMP(1,II).NE.NACTIV(4,IJ)) GO TO 770                          F 379
      IF (NCOMP(2,II).NE.NACTIV(5,IJ)) GO TO 750                          F 380
      IF (NCOMP(3,II).EQ.NACTIV(6,IJ)) GO TO 760                          F 381
      IF (NCOMP(3,II).EQ.0) GO TO 760                                     F 382
      GO TO 770                                                           F 383
  750 IF (NCOMP(2,II).EQ.0) GO TO 760                                     F 384
      GO TO 770                                                           F 385
C     ACCUMULATE P(T,C,R) FOR THE COMPONENT                               F 386
  760 NCOMP(34,II)=NPAT+NCOMP(34,II)                                      F 387
      NCOMP(35,II)=NPAC+NCOMP(35,II)                                      F 388
      NCOMP(36,II)=NPAR+NCOMP(36,II)                                      F 389
      IF (NTE.LE.NCOMP(37,II)) GO TO 770                                  F 390
C     GREATEST EXPECTED COMPLETION FOR THE COMPONENT                      F 391
      NCOMP(37,II)=NTE                                                    F 392
  770 CONTINUE                                                            F 393
C     SAVE OLD AND STORE NEW P(T,C,R),EXPECTED COMPLETION, AND DURATION   F 394
      DO 780 J=1,5                                                        F 395
      NACTIV(24+J,IJ)=NACTIV(37+J,IJ)                                     F 396
  780 CONTINUE                                                            F 397
      NACTIV(42,IJ)=NTE                                                   F 398
      NACTIV(41,IJ)=NTD                                                   F 399
      NACTIV(40,IJ)=NPAR                                                  F 400
      NACTIV(39,IJ)=NPAC                                                  F 401
      NACTIV(38,IJ)=NPAT                                                  F 402
      IHOLD=NTD-NACTIV(15,IJ)                                             F 403
      IF (IABS(IHOLD).LT.10) GO TO 790                                    F 404
C                                                                         F 405
C        ADDED BY WOLF RESEARCH JUNE 1972                                 F 406
C                                                                         F 407
C        THE FOLLOWING CODE SORTS THE INFORMATION PERTAINING              F 408
C        TO THE 'ACTIVITY TIME CHANGES' CHART AND OUTPUTS                 F 409
C        SAID INFORMATION IN ASCENDING ORDER WITH RESPECT TO              F 410
C        THE W.B.S. NUMBER IN THE REPORT                                  F 411
C                                                                         F 412
      NSORT(IKK)=IJ                                                       F 413
      NN=IKK                                                              F 414
      MM=NN                                                               F 415
      IKK=IKK+1                                                           F 416
  790 IF (IJ.EQ.N) GO TO 810                                              F 417
  800 CONTINUE                                                            F 418
  810 IFLAG=0                                                             F 419
      DO 820 JK=1,NN                                                      F 420
      IF (JK.EQ.NN) GO TO 820                                             F 421
      IL=NSORT(JK)                                                        F 422
      IM=NSORT(JK+1)                                                      F 423
      JIL=10*(10*NACTIV(4,IL)+NACTIV(5,IL))+NACTIV(6,IL)                  F 424
      JIM=10*(10*NACTIV(4,IM)+NACTIV(5,IM))+NACTIV(6,IM)                  F 425
      IF (JIL.LE.JIM) GO TO 820                                           F 426
      IFLAG=1                                                             F 427
      ITEMP=NSORT(JK)                                                     F 428
      NSORT(JK)=NSORT(JK+1)                                               F 429
      NSORT(JK+1)=ITEMP                                                   F 430
  820 CONTINUE                                                            F 431
      NN=NN-1                                                             F 432
      IF (IFLAG.EQ.1) GO TO 810                                           F 433
      DO 830 IMM=1,MM                                                     F 434
      IL=NSORT(IMM)                                                       F 435
      NTD=NACTIV(41,IL)                                                   F 436
      IHOLD=NTD                                                           F 437
      FNTD=FLOAT(IHOLD)/10.0                                              F 438
      IHOLD=NACTIV(28,IL)                                                 F 439
      FNC=FLOAT(IHOLD)/10.0                                               F 440
      FDIF2=FNTD-FNC                                                      F 441
      IHOLD=NACTIV(15,IL)                                                 F 442
      FNAC=FLOAT(IHOLD)/10.0                                              F 443
      FDIF=FNTD-FNAC                                                      F 444
      WRITE (6,1510) NACTIV(4,IL),NACTIV(5,IL),NACTIV(6,IL),NACTIV(1,IL)  F 445
     1,NACTIV(2,IL),(NACTIV(II,IL),II=55,66),FNC,FNTD,FDIF2,FNAC,FDIF     F 446
  830 CONTINUE                                                            F 447
C                                                                         F 448
C        END OF WOLF CODE  JUNE 1972   S.H.                               F 449
C                                                                         F 450
C     END OF FORWARD PASS ON ACTIVITIES OF THE PROJECT *****              F 451
C     **** AVERAGE COMPONENT P(T,C,R) FOR ALL COMPONENTS ***              F 452
      NC=NCOM(3)                                                          F 453
      DO 870 II=1,NC                                                      F 454
      ICNT=0                                                              F 455
      DO 860 I=1,N                                                        F 456
      CALL UNPAK (NBIT,15,I)                                              F 457
      IF (NBIT.GE.0) GO TO 860                                            F 458
      IF (NCOMP(1,II).NE.NACTIV(4,I)) GO TO 860                           F 459
      IF (NCOMP(2,II).NE.NACTIV(5,I)) GO TO 840                           F 460
      IF (NCOMP(3,II).EQ.NACTIV(6,I)) GO TO 850                           F 461
      IF (NCOMP(3,II).EQ.0) GO TO 850                                     F 462
      GO TO 860                                                           F 463
  840 IF (NCOMP(2,II).EQ.0) GO TO 850                                     F 464
      GO TO 860                                                           F 465
C     COUNT ALL EXISTING ACTIVITIES PER COMPONENT                         F 466
  850 ICNT=ICNT+1                                                         F 467
C     FOR ALL ACTIVITIES COMPLETED PREVIOUS TO THE FORWARD PASS, ADD THE  F 468
C      P(T,C,R) OF THESE ACTIVITIES TO ACCUMULATED P(T,C,R) FOR THE JUST  F 469
C      COMPLETED AND UNCOMPLETED ACTIVITIES IN THE COMPONENTS IN WHICH    F 470
C      THE ACTIVITIES EXIST.                                              F 471
      CALL UNPAK (NBIT,13,I)                                              F 472
      IF (NBIT.GE.0) GO TO 860                                            F 473
      CALL UNPAK (NBIT,6,I)                                               F 474
      IF (NBIT.LT.0) GO TO 860                                            F 475
      NCOMP(34,II)=NCOMP(34,II)+NACTIV(38,I)                              F 476
      NCOMP(35,II)=NCOMP(35,II)+NACTIV(39,I)                              F 477
      NCOMP(36,II)=NCOMP(36,II)+NACTIV(40,I)                              F 478
  860 CONTINUE                                                            F 479
C     THE COMPONENTS OF UNAWARDED CONTRACTS DONT EXIST. NEITHER DO THE    F 480
C      ACTIVITIES IN THESE COMPONENTS (ICNT = 0) SKIP AVERAGE             F 481
      IF (ICNT.EQ.0) GO TO 870                                            F 482
      NCOMP(34,II)=NCOMP(34,II)/ICNT                                      F 483
C     AVERAGE P(T,C,R) FOR THE COMPONENT = ACCUMULATED P(T,C,R) FOR THE   F 484
C      ACTIVITIES IN THE COMPONENT / NBR ACTIVITIES IN THE COMPONENT.     F 485
      NCOMP(35,II)=NCOMP(35,II)/ICNT                                      F 486
      NCOMP(36,II)=NCOMP(36,II)/ICNT                                      F 487
  870 CONTINUE                                                            F 488
C     STORE GREATEST EXPECTED COMPLETION FOR THE PROJECT                  F 489
      NCOM(15)=LGTE                                                       F 490
C     **** SAVE LAST(CURRENT BEFORE COMPUTATIONS) COMPONENT COSTS AND     F 491
C      ACTUAL COMPONENT COSTS. INITIALIZE COMPONENT COSTS                 F 492
C     COMPONENT COSTS = ACTUAL COSTS # ESTIMATED COMPLETION COSTS         F 493
      NC=NCOM(3)                                                          F 494
      DO 880 J=1,NC                                                       F 495
      DO 880 I=1,5                                                        F 496
      NCOMP(I+19,J)=NCOMP(I+28,J)                                         F 497
      NCOMP(I+37,J)=NCOMP(I+42,J)                                         F 498
      NCOMP(I+28,J)=0                                                     F 499
  880 CONTINUE                                                            F 500
C      ***************************************************************    F 501
C     BEGIN BACKWARD PASS                                                 F 502
C      ***************************************************************    F 503
      DO 1350 I=1,N                                                       F 504
C     J = BACKWARD INDEX OF ACTIVITIES IE LAST TO FIRST                   F 505
      J=N-I+1                                                             F 506
C     GET ACTIVITIES WHICH EXIST AND WERE NOT COMPLETED BEFORE THE FOR-   F 507
C      WARD PASS.(NOT COMPLETED OR COMPLETED,JUST COMPLETED)              F 508
      CALL UNPAK (NBIT,15,J)                                              F 509
      IF (NBIT.GE.0) GO TO 1350                                           F 510
      CALL UNPAK (NBIT,13,J)                                              F 511
      IF (NBIT.GE.0) GO TO 890                                            F 512
      CALL UNPAK (NBIT,6,J)                                               F 513
      IF (NBIT.GE.0) GO TO 1350                                           F 514
C     INITIALIZE COST PARAMETERS                                          F 515
  890 NDUM1=0                                                             F 516
      NDUM2=0                                                             F 517
      NDUM3=0                                                             F 518
C      COMPUTE SLACKS                                                     F 519
      DO 900 IC=1,8                                                       F 520
      NACTIV(29+IC,J)=NACTIV(42+IC,J)                                     F 521
  900 CONTINUE                                                            F 522
      MQ=0                                                                F 523
      CALL UNPAK (NBIT,10,J)                                              F 524
      IF (NBIT.GE.0) GO TO 910                                            F 525
      MQ=1                                                                F 526
      NACTIV(43,J)=LGTE                                                   F 527
      NSMTBE=LGTE                                                         F 528
      IF (NTRACT(3,1).NE.0) NACTIV(43,J)=NTRACT(3,1)                      F 529
      GO TO 930                                                           F 530
  910 J1=J+1                                                              F 531
      IF (J1.GT.N) J1=N                                                   F 532
      NSMTBE=2600                                                         F 533
      NACTIV(43,J)=2600                                                   F 534
      DO 920 I1=J1,N                                                      F 535
      CALL UNPAK (NBIT,15,I1)                                             F 536
      IF (NBIT.GE.0) GO TO 920                                            F 537
      IF (NACTIV(1,I1).NE.NACTIV(2,J)) GO TO 920                          F 538
      NTBL=NACTIV(43,I1)-NACTIV(41,I1)                                    F 539
      NTBE=NACTIV(42,I1)-NACTIV(41,I1)                                    F 540
      IF (NTBL.LT.NACTIV(43,J)) NACTIV(43,J)=NTBL                         F 541
      IF (NTBE.LT.NSMTBE) NSMTBE=NTBE                                     F 542
      MQ=1                                                                F 543
  920 CONTINUE                                                            F 544
C     IF NO SUCCESSOR OR SCHEDULED COMPLETION DATE, SET SLACK = 0         F 545
      IF (MQ.EQ.0) NACTIV(43,J)=NACTIV(42,J)                              F 546
  930 NACTIV(44,J)=NACTIV(43,J)-NACTIV(42,J)                              F 547
      DO 940 I1=1,3                                                       F 548
  940 IF (NACTIV(42+I1,J).GT.2600) NACTIV(42+I1,J)=2600                   F 549
      NACTIV(45,J)=NSMTBE-NACTIV(42,J)                                    F 550
C     COST COMPUTATIONS MUST BE DONE ON BACKWARD PASS SINCE SLACK IS      F 551
C     USED IN THE CALCULATIONS                                            F 552
      IF (NACTIV(28,J).EQ.0) GO TO 1350                                   F 553
C     SEE IF ACTIONS AGAINST ACTIVITIES EXIST, IF SO,                     F 554
      IF (KA.EQ.0) GO TO 960                                              F 555
      N1=100-NACTIV(53,J)*1000/NACTIV(28,J)                               F 556
      N2=100+NACTIV(53,J)*1000/NACTIV(28,J)                               F 557
      DO 950 L=1,KA                                                       F 558
      IF (NAA(2,L).NE.NACTIV(3,J)) GO TO 950                              F 559
      NCTN=NAA(1,L)                                                       F 560
C     NDUM1 = SUM OF PERCENTAGE CHANGES TO BASE COST                      F 561
C     NDUM2 = SUM OF ABSOLUTE COST CHANGES                                F 562
C     NDUM3 = SUM OF PER ENTAGE CHANGES IN CURRENT COSTS                  F 563
C     SEE IF PERCENT COST CHANGES REQUIRED BY INPUT ACTIONS NCODE 17 OR   F 564
      IF (NACTN(11,NCTN).EQ.17) NDUM3=N2                                  F 565
      IF (NACTN(11,NCTN).EQ.21) NDUM3=N1                                  F 566
      NDUM1=NDUM1+NACTN(13,NCTN)                                          F 567
      NDUM2=NDUM2+NACTN(14,NCTN)+NAA(3,L)                                 F 568
  950 CONTINUE                                                            F 569
  960 IF (KC.EQ.0) GO TO 1000                                             F 570
      DO 990 L=1,KC                                                       F 571
      IF (NAC(2,L).NE.NACTIV(4,J)) GO TO 990                              F 572
      IF (NAC(3,L).NE.NACTIV(5,J)) GO TO 970                              F 573
      IF (NAC(4,L).EQ.NACTIV(6,J)) GO TO 980                              F 574
      IF (NAC(4,L).EQ.0) GO TO 980                                        F 575
      GO TO 990                                                           F 576
  970 IF (NAC(3,L).NE.0) GO TO 990                                        F 577
  980 NCTN=NAC(1,L)                                                       F 578
      NDUM1=NDUM1+NACTN(13,NCTN)+NAC(5,L)                                 F 579
      NDUM2=NDUM2+NACTN(14,NCTN)                                          F 580
  990 CONTINUE                                                            F 581
 1000 CONTINUE                                                            F 582
C     IN THE BACKWARD PASS WE ONLY LOCATE ACTIVITIES NOT COMPLETE OR      F 583
C     JUST COMPLETED THIS PERIOD,THEREFORE WE MUST KEEP ACTUAL COSTS      F 584
C     IN THE COMPONENT FILE TO COMPUTE NEW ACTUALS AND TOTALS             F 585
C      COSTS ARE STORED  IN UNITS OF 1 K $                                F 586
C                                                                         F 587
      CALL UNPAK (NBIT,4,J)                                               F 588
      IF (NBIT.GE.0) GO TO 1010                                           F 589
      GO TO 1050                                                          F 590
 1010 L=NACTIV(39,J)                                                      F 591
      LL=NACTIV(26,J)                                                     F 592
      IF (LL.EQ.0) LL=1                                                   F 593
      MCONST=((NDIST(L)-NDIST(LL))*NACTIV(11,J))/100                      F 594
      IF (NACTIV(28,J).EQ.0) GO TO 1020                                   F 595
      NALPHA=(NACTIV(45,J)-NACTIV(32,J))/NACTIV(28,J)                     F 596
      GO TO 1030                                                          F 597
 1020 NALPHA=0                                                            F 598
 1030 NACTIV(46,J)=NACTIV(46,J)+(NDUM1*NACTIV(20,J))/100+(NALPHA*NACTIV(  F 599
     121,J))/4-MCONST+NDUM2                                               F 600
C     FOLLOWING CODE IS OBSOLETE                                          F 601
C     OVERTIME COSTS                                                      F 602
C     CALL UNPAK(NBIT,14,J)                                               F 603
C     IF(NBIT.LT.0) NACTIV(46,J) = 14*NACTIV(46,J)/10                     F 604
C     IF (NBIT.LT.0) GO TO 191                                            F 605
C     CALL UNPAK(IBIT,2,J)                                                F 606
C     IF (IBIT.LT.0) NACTIV(46,J)=50*NACTIV(46,J)/70                      F 607
C     191 CALL PACK(0,2,J)                                                F 608
C     CALL PACK(0,14,J)                                                   F 609
C     DOUBLE COSTS FOR TEST FAILURE                                       F 610
      CALL UNPAK (NBIT,8,J)                                               F 611
      IF (NBIT.LT.0) NACTIV(46,J)=2*NACTIV(46,J)                          F 612
      IF (NACTIV(46,J).LT.(NACTIV(20,J)/3)) NACTIV(46,J)=NACTIV(20,J)/3   F 613
      IF (NDUM3.EQ.0) GO TO 1040                                          F 614
      NACTIV(46,J)=NACTIV(46,J)*NDUM3/100                                 F 615
 1040 IF (NACTIV(46,J).LT.0) NACTIV(46,J)=NACTIV(20,J)/3                  F 616
      IF (NACTIV(46,J).GT.1200) NACTIV(46,J)=1200                         F 617
 1050 NCONST=10*(NACTIV(46,J)-NACTIV(20,J))                               F 618
      NRND=5                                                              F 619
      IF (NCONST.LT.0) NRND=-5                                            F 620
C     COMPUTE ENGINEERING,TECHNICAL,MATERIAL AND SUBCONTRACT COSTS        F 621
      IF (NACTIV(20,J).EQ.0) GO TO 1070                                   F 622
      DO 1060 KK=1,4                                                      F 623
      NACTIV(46+KK,J)=NACTIV(20+KK,J)+(((NCONST*NACTIV(20+KK,J))/NACTIV(  F 624
     120,J)+NRND)/10)                                                     F 625
 1060 CONTINUE                                                            F 626
      GO TO 1090                                                          F 627
 1070 DO 1080 KK=1,4                                                      F 628
      NACTIV(46+KK,J)=NACTIV(20+KK,J)+(NRND/10)                           F 629
 1080 CONTINUE                                                            F 630
 1090 NSUM=NACTIV(47,J)+NACTIV(48,J)+NACTIV(49,J)+NACTIV(50,J)            F 631
      IF (NSUM.EQ.NACTIV(46,J)) GO TO 1110                                F 632
      MAXC=0                                                              F 633
      DO 1100 II=2,5                                                      F 634
      IF (NACTIV(45+II,J).LE.MAXC) GO TO 1100                             F 635
      MAXC=NACTIV(45+II,J)                                                F 636
      JJ=II                                                               F 637
 1100 CONTINUE                                                            F 638
      NRND=1                                                              F 639
      IF (NSUM.GT.NACTIV(46,J)) NRND=-1                                   F 640
      NACTIV(45+JJ,J)=NACTIV(45+JJ,J)+NRND                                F 641
      NSUM=NSUM+NRND                                                      F 642
      IF (NSUM.EQ.NACTIV(46,J)) GO TO 1110                                F 643
      NACTIV(45+JJ,J)=NACTIV(45+JJ,J)+NRND                                F 644
C      ***************************************************************    F 645
C     ALL COSTS FOR THIS ACTIVITY ARE NOW UPDATED AND IN NOUT             F 646
C     UPDATE COMPONENT FILE, ACTIVITIES JUST COMPLETED ARE ADDED TO       F 647
C     ACTUAL COSTS                                                        F 648
C     LOCATE COMPONENTS IN FILE WHICH CONTAIN THIS ACTIVITY               F 649
C      ***************************************************************    F 650
 1110 NC=NCOM(3)                                                          F 651
      DO 1340 L=1,NC                                                      F 652
      IF (NCOMP(1,L).NE.NACTIV(4,J)) GO TO 1340                           F 653
      IF (NCOMP(2,L).NE.NACTIV(5,J)) GO TO 1120                           F 654
      IF (NCOMP(3,L).NE.NACTIV(6,J)) GO TO 1130                           F 655
      GO TO 1140                                                          F 656
 1120 IF (NCOMP(2,L).NE.0) GO TO 1340                                     F 657
      GO TO 1140                                                          F 658
 1130 IF (NCOMP(3,L).NE.0) GO TO 1340                                     F 659
C      ***************************************************************    F 660
C     UPDATE COMPONENT FILE                                               F 661
C      ***************************************************************    F 662
 1140 CONTINUE                                                            F 663
      II=NCOM(21)-NCOM(17)                                                F 664
      NYR=NCOM(20)                                                        F 665
      IF (II.GE.1) GO TO 1150                                             F 666
      II=II+12                                                            F 667
      NYR=NYR-1                                                           F 668
 1150 NDY=NDATE(II)                                                       F 669
      NL=MONS(II)                                                         F 670
      CALL DTCONV (NDY,NL,NYR,NSTRT)                                      F 671
      II=NCOM(21)                                                         F 672
      NYR=NCOM(20)                                                        F 673
      NDY=NDATE(II)                                                       F 674
      NL=MONS(II)                                                         F 675
      CALL DTCONV (NDY,NL,NYR,NSTOP)                                      F 676
      KSTRT=NACTIV(42,J)-NACTIV(41,J)                                     F 677
      IF (KSTRT.LT.NSTOP.AND.NACTIV(42,J).GT.NSTRT) GO TO 1160            F 678
      IF=0                                                                F 679
      GO TO 1210                                                          F 680
 1160 IF (KSTRT.LT.NSTRT.OR.NACTIV(42,J).GT.NSTOP) GO TO 1170             F 681
      IF=1000                                                             F 682
      GO TO 1210                                                          F 683
 1170 IF (NACTIV(41,J).NE.0) GO TO 1180                                   F 684
      IF=0                                                                F 685
      GO TO 1210                                                          F 686
 1180 IF (KSTRT.LT.NSTRT) GO TO 1190                                      F 687
      IF=((NSTOP-KSTRT)*1000)/NACTIV(41,J)                                F 688
      GO TO 1210                                                          F 689
 1190 IF (KSTRT.GT.NSTRT.OR.NACTIV(42,J).LE.NSTOP) GO TO 1200             F 690
      IF=((NSTOP-NSTRT)*1000)/NACTIV(41,J)                                F 691
      GO TO 1210                                                          F 692
 1200 IF=((NACTIV(42,J)-NSTRT)*1000)/NACTIV(41,J)                         F 693
 1210 DO 1220 K=1,5                                                       F 694
      IBACK=((IF*NACTIV(45+K,J))+499)/1000                                F 695
 1220 NCOMP(K+42,L)=NCOMP(K+42,L)+IBACK                                   F 696
      NSTRT=NSTOP                                                         F 697
      II=II+30                                                            F 698
 1230 IF (II.LE.12) GO TO 1240                                            F 699
      II=II-12                                                            F 700
      NYR=NYR+1                                                           F 701
      GO TO 1230                                                          F 702
 1240 NDY=NDATE(II)                                                       F 703
      NL=MONS(II)                                                         F 704
      CALL DTCONV (NDY,NL,NYR,NSTOP)                                      F 705
      IF (KSTRT.LT.NSTOP.AND.NACTIV(42,J).GT.NSTRT) GO TO 1250            F 706
      IF=0                                                                F 707
      GO TO 1300                                                          F 708
 1250 IF (KSTRT.LT.NSTRT.OR.NACTIV(42,J).GT.NSTOP) GO TO 1260             F 709
      IF=1000                                                             F 710
      GO TO 1300                                                          F 711
 1260 IF (NACTIV(41,J).NE.0) GO TO 1270                                   F 712
      IF=0                                                                F 713
      GO TO 1300                                                          F 714
 1270 IF (KSTRT.LT.NSTRT) GO TO 1280                                      F 715
      IF=((NSTOP-KSTRT)*1000)/NACTIV(41,J)                                F 716
      GO TO 1300                                                          F 717
 1280 IF (KSTRT.GT.NSTRT.OR.NACTIV(42,J).LE.NSTOP) GO TO 1290             F 718
      IF=((NSTOP-NSTRT)*1000)/NACTIV(41,J)                                F 719
      GO TO 1300                                                          F 720
 1290 IF=((NACTIV(42,J)-NSTRT)*1000)/NACTIV(41,J)                         F 721
 1300 DO 1310 K=1,5                                                       F 722
      IBACK=((IF*NACTIV(45+K,J))+499)/1000                                F 723
      NCOMP(K+28,L)=NCOMP(K+28,L)+IBACK                                   F 724
 1310 CONTINUE                                                            F 725
 1320 NSUM=NCOMP(44,L)+NCOMP(45,L)+NCOMP(46,L)+NCOMP(47,L)                F 726
      IF (NSUM.EQ.NCOMP(43,L)) GO TO 1340                                 F 727
      MAXC=0                                                              F 728
      DO 1330 II=1,4                                                      F 729
      IF (NCOMP(43+II,L).LE.MAXC) GO TO 1330                              F 730
      MAXC=NCOMP(43+II,L)                                                 F 731
      JJ=II                                                               F 732
 1330 CONTINUE                                                            F 733
      NRND=1                                                              F 734
      IF (NSUM.GT.NCOMP(43,L)) NRND=-1                                    F 735
      NCOMP(43+JJ,L)=NCOMP(43+JJ,L)+NRND                                  F 736
      GO TO 1320                                                          F 737
 1340 CONTINUE                                                            F 738
 1350 CONTINUE                                                            F 739
      NCTR=NCOM(4)                                                        F 740
      DO 1380 I=1,NCTR                                                    F 741
      IF (NTRACT(13,I).EQ.0) GO TO 1380                                   F 742
      NX=NTRACT(1,I)                                                      F 743
      NY=0                                                                F 744
      NZ=0                                                                F 745
      CALL CSRCH (NX,NY,NZ,ICOMP)                                         F 746
      NTRACT(10,I)=(7*NCOMP(43,ICOMP)*NTRACT(5,I))/1000                   F 747
      NTRACT(11,I)=(7*NTRACT(10,I))/10                                    F 748
C      DONT ALLOW PAYMENTS TO EXCEED FUNDING                              F 749
      IF (NTRACT(11,I).GT.NTRACT(4,I)) NTRACT(11,I)=NTRACT(4,I)           F 750
      NTRACT(8,I)=NCOMP(29,ICOMP)-NTRACT(9,I)+NCOMP(43,ICOMP)             F 751
C     CHECK OVERRUN AND FUNDING FOR FREEZE                                F 752
      IF ((NTRACT(8,I).GT.NTRACT(9,I)*2/5).OR.(10*NTRACT(10,I)/7.GT.NTRA  F 753
     1CT(4,I))) GO TO 1360                                                F 754
      GO TO 1370                                                          F 755
 1360 IF (NTRACT(7,I).EQ.0) NTRACT(12,I)=NTIME                            F 756
      GO TO 1380                                                          F 757
 1370 IF (NTRACT(7,I).EQ.1) NTRACT(6,I)=NTIME                             F 758
 1380 CONTINUE                                                            F 759
      WRITE (11) NACTIV                                                   F 760
      WRITE (11) IPERB,NCOMP,NTRACT,NACTN,NDIST,NCOM,NREP,MONS,NDAYS,NDA  F 761
     1TE                                                                  F 762
C     PERTURBATION REPORT BEGINS HERE                                     F 763
      ICNT=0                                                              F 764
      NP=NCOM(2)                                                          F 765
      IF (NP.EQ.0) GO TO 1440                                             F 766
      WRITE (6,1520)                                                      F 767
      DO 1430 I=1,NP                                                      F 768
      IPBS=IBLK                                                           F 769
      IF (IPERB(21,I).NE.0) IPBS=IYES                                     F 770
C      SEE IF SUBSYSTEM FOR THIS PERB IS ACTIVE                           F 771
      ICNT=NCOM(3)                                                        F 772
      DO 1390 K=1,ICNT                                                    F 773
      IF (IPERB(2,I).NE.NCOMP(1,K)) GO TO 1390                            F 774
      IF (IPERB(3,I).NE.NCOMP(2,K)) GO TO 1390                            F 775
      IF (IPERB(4,I).NE.NCOMP(3,K)) GO TO 1390                            F 776
      IF (NCOMP(36,K).GT.0) GO TO 1400                                    F 777
 1390 CONTINUE                                                            F 778
      GO TO 1430                                                          F 779
C     FIND CRITICAL ACTIVITY'S ESTIMATED START DATE                       F 780
 1400 CALL ASRCH (I,IJ)                                                   F 781
C     IF STARTED OR COMPLETED--DONT PRINT                                 F 782
      CALL UNPAK (NBIT,13,IJ)                                             F 783
      IF (NBIT.NE.0) GO TO 1430                                           F 784
      CALL UNPAK (NBIT,12,IJ)                                             F 785
      IF (NBIT.NE.0) GO TO 1430                                           F 786
      NDUR=NACTIV(41,IJ)                                                  F 787
      NTE=NACTIV(42,IJ)                                                   F 788
      NDUM1=10*(NTE+NCOM(10)-NDUR)                                        F 789
      IHOLD=NDUM1                                                         F 790
      NDUM2=MOD(IHOLD,5217)                                               F 791
      IF (NDUM2.EQ.0) NDUM2=1                                             F 792
      NDUM3=0                                                             F 793
      DO 1410 NX=1,13                                                     F 794
      IF (NDUM3.GE.NDUM2) GO TO 1420                                      F 795
      NDUM3=NDUM3+TBL(NX)                                                 F 796
 1410 CONTINUE                                                            F 797
 1420 IN(3)=NCOM(11)+NDUM1/5217                                           F 798
      IN(1)=(7*(NDUM2-NDUM3+TBL(NX-1))+93)/100                            F 799
      WRITE (6,1530) IPERB(1,I),IPBS,NACTIV(1,IJ),NACTIV(2,IJ),IN(1),MON  F 800
     1S(NX-1),IN(3),(NACTIV(K,IJ),K=55,66)                                F 801
      IF (IPBS.EQ.IYES) ICNT=1                                            F 802
 1430 CONTINUE                                                            F 803
 1440 IF (ICNT.EQ.0) WRITE (6,1540)                                       F 804
      RETURN                                                              F 805
C      PERTURBATION REPORT CONTINUED IN SUBR "GENRP"                      F 806
 1450 MQ=102                                                              F 807
      NPASS=NCOM(6)                                                       F 808
      WRITE (6,1480) MQ,NPASS                                             F 809
      NCOM(9)=2                                                           F 810
      RETURN                                                              F 811
C                                                                         F 812
 1460 FORMAT (11H0NO ERRORS.)                                             F 813
 1470 FORMAT (1H1,49X,'ACTIVITY TIME CHANGES',/,50X,'(EXCEEDING ONE WEEK  F 814
     1 )',/,23X,'W.B.S. PRED SUCC'3X,'ACTIVITY'20X,'LAST   NOW  CHANGE'4  F 815
     2X,'BASE  NET CHANGE')                                               F 816
 1480 FORMAT (13H0ERROR NUMBER,I3,10X,12H IDENTIFIER-,I8)                 F 817
 1490 FORMAT ('  INVALID ACTION NUMB =',I10,'FOR ACTIV NO.'I5)            F 818
 1500 FORMAT ('  INVALID ACTION NUMB 'I10,'FOR COMPON NO.'3I2)            F 819
 1510 FORMAT (23X,I2,2I1,2X,2I5,3X,12A2,2X,3F6.1,3X,2F6.1)                F 820
 1520 FORMAT ('0',60X,'PERTURBATION STATUS'///7X,'NO SUBM.'5X'CRITICAL A  F 821
     1CTIVITY    EXPECTED ACTIVATION'//)                                  F 822
 1530 FORMAT (5X,I4,A4,7X,I4,2X,'TO',I5,I9,A4,I3,4X,12A2,)                F 823
 1540 FORMAT (6X,'NONE PENDING')                                          F 824
      END                                                                 F 825-
      SUBROUTINE ERROR2 (N1,N2,NI)                                        G   1
C                                                                         G   2
C     ERROR2 IS A NON TERMINATING PROCESSING ERROR ROUTINE                G   3
C                                                                         G   4
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        G   5
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  G   6
     120),NAC(5,120)                                                      G   7
      COMMON MONS(12)                                                     G   8
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  G   9
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     G  10
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  G  11
     1A,KC,IPERB,NDIST,IN,NAA,NAC                                         G  12
      INTEGER*2 I                                                         G  13
      DIMENSION ERR(9,3)                                                  G  14
      DATA ERR/108HINPUT CARDS MISSING.                INPUT CARDS OUT O  G  15
     1F SEQUENCE.        NO INPUT CARDS.  END OF INPUT DECK. /            G  16
C                                                                         G  17
C                                                                         G  18
C     INPUT PLAYER NON-PROCESSING                                         G  19
C     SET ERROR FLAG                                                      G  20
      NCOM(9)=1                                                           G  21
C                                                                         G  22
C     DECIDE AND OUTPUT PARTICULAR MESSAGE DESIRED BY CALLING ROUTINE     G  23
C      FOR NON-TERMINATING ERROR (CARDS AND TAPE NOT ALLINED)             G  24
C                                                                         G  25
      GO TO (110,120), N1                                                 G  26
C                                                                         G  27
C     FILE PLAYER NON-PROCESSING(CARDS AHEAD OF TAPE)                     G  28
C                                                                         G  29
  110 WRITE (6,140) NCOM(6)                                               G  30
      GO TO 130                                                           G  31
C                                                                         G  32
C                                                                         G  33
  120 WRITE (6,150) NI                                                    G  34
  130 WRITE (6,160) (ERR(I,N2),I=1,9)                                     G  35
      RETURN                                                              G  36
C                                                                         G  37
  140 FORMAT (25H0NO PLAY FOR FILE PLAYER I2)                             G  38
  150 FORMAT (26H0NO PLAY FOR INPUT PLAYER I2)                            G  39
  160 FORMAT (1H ,9A4)                                                    G  40
      END                                                                 G  41-
      SUBROUTINE ASRCH (NN,J)                                             H   1
C                                                                         H   2
C     ASRCH SEARCHS THE ACTIVITH FILE NACTIV FOR A MATCH ON CRITICAL      H   3
C      ACTIVITY NBR CONTAINED IN THE PERTURBATION FILE ENTRY NN. THE      H   4
C      INDEX OF THE CRITICAL ACTIVITY ENTRY IS RETURNED IN J.             H   5
C                                                                         H   6
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  H   7
     1                                                                    H   8
      DIMENSION ACTN(16,120)                                              H   9
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        H  10
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  H  11
     120),NAC(5,120)                                                      H  12
      COMMON MONS(12)                                                     H  13
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  H  14
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     H  15
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  H  16
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                H  17
      INTEGER*2 NN,J,I                                                    H  18
C                                                                         H  19
C                                                                         H  20
      DO 110 I=1,N                                                        H  21
      IF (NACTIV(3,I).NE.IPERB(5,NN)) GO TO 110                           H  22
      J=I                                                                 H  23
      RETURN                                                              H  24
  110 CONTINUE                                                            H  25
      J=0                                                                 H  26
      RETURN                                                              H  27
      END                                                                 H  28-
      SUBROUTINE CSRCH (NC,NL,NK,ICOMP)                                   I   1
C                                                                         I   2
C     CSRCH SEARCHS THE COMPONENT FILE NCOMP FOR A MATCH ON EQUAL COM-    I   3
C      PONENT NBR = CONTRACT NBR NC, SYSTEM NBR NL, AND SUBSYSTEM NBR     I   4
C      NK. THE INDEX OF THE MATCHING COMPONENT ENTRY IS RETURNED IN       I   5
C      ICOMP.                                                             I   6
C      TERMINATING ERROR 13 IF NOT FOUND                                  I   7
C                                                                         I   8
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        I   9
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  I  10
     120),NAC(5,120)                                                      I  11
      COMMON MONS(12)                                                     I  12
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  I  13
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     I  14
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  I  15
     1A,KC,IPERB,NDIST,IN,NAA,NAC                                         I  16
C      ***************************************************************    I  17
C      ***************************************************************    I  18
      INTEGER*2 I,NC,NL,NK,ICOMP,J                                        I  19
      EQUIVALENCE (NCOM(3),I)                                             I  20
      DO 110 J=1,I                                                        I  21
      IF (NCOMP(1,J).EQ.NC.AND.NCOMP(2,J).EQ.NL.AND.NCOMP(3,J).EQ.NK) GO  I  22
     1 TO 120                                                             I  23
  110 CONTINUE                                                            I  24
      ICOMP=0                                                             I  25
      RETURN                                                              I  26
  120 ICOMP=J                                                             I  27
      RETURN                                                              I  28
      END                                                                 I  29-
      SUBROUTINE ACTION (NO)                                              J   1
C                                                                         J   2
C     ACTION ACCUMULATES (1) NBR OF ACTION EFFECTS ON ALL ACTIVITIES FOR  J   3
C      ALL ACTIONS. KA = NBR, NAA = ACTION NBR-ACTIVITY NBR LINKS FOR     J   4
C      FORWAR TO MAKE, (2) NBR OF ACTION EFFECTS ON COMPONENT STATED,     J   5
C      KC = NAC = ACTION NBR-COMPONENT NBR LINKS FOR FORWAR TO MAKE       J   6
C      AND, PROCESSES LOGICAL(NOT CALCULATED(IN FORWAR)) EFFECTS ON THE   J   7
C      FILES BY SELECTING AN APPROPRIATE ACTION ROUTINE(S)                J   8
C                                                                         J   9
C     REVISED 1/74 TO                                                     J  10
C         A) CONVERT MOST TERMINATING ERRORS TO NONTERMINATING            J  11
C                                                                         J  12
C         B) ADD INCREMENTAL FUNDING OF CONTRACTS (NCODE14)               J  13
C                                                                         J  14
C         C) ADD NCODES 29 + 30 TO DELETE OR RESTORE AN ACTIVITY          J  15
C                                                                         J  16
C          D)ADD ACTION 99 FOR QUARTERLY UPDATE PER PLAY                  J  17
C                                                                         J  18
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  J  19
     1                                                                    J  20
      DIMENSION ACTN(16,120)                                              J  21
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        J  22
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  J  23
     120),NAC(5,120)                                                      J  24
      COMMON MONS(12)                                                     J  25
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  J  26
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     J  27
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  J  28
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA,NK                             J  29
      INTEGER*2 I,J,K,NO,NBIT,NCTN,NTIME,NDY,NYR,NCODE1,NCODE2,NCODE3     J  30
C                                                                         J  31
C                                                                         J  32
C     REST LOOP  FOR "NREP" FOR CONTRACTS CANCELLED LAST PLAY             J  33
      MJOHN=NCOM(4)                                                       J  34
      DO 120 NJ=1,5                                                       J  35
      DO 110 NI=1,MJOHN                                                   J  36
      IF (NTRACT(13,NI).NE.0) GO TO 110                                   J  37
      IF (NREP(NI,NJ).GT.3) NREP(NI,NJ)=3                                 J  38
  110 CONTINUE                                                            J  39
  120 CONTINUE                                                            J  40
C     UPDATE PERIOD NUMBER                                                J  41
      NCOM(8)=NCOM(8)+1                                                   J  42
      IF (IN(18).NE.NCOM(8)) WRITE (6,810) IN(18),NCOM(8)                 J  43
C      CLEAR EFFECTS TRANSFER FILES                                       J  44
      DO 140 NJ=1,120                                                     J  45
      DO 130 KA=1,3                                                       J  46
  130 NAA(KA,NJ)=0                                                        J  47
      DO 140 KC=1,5                                                       J  48
      NAC(KC,NJ)=0                                                        J  49
  140 CONTINUE                                                            J  50
C     INITIALIZE ACCUMULATORS, UPDATE NTIME MONTH AND YEAR                J  51
      KA=0                                                                J  52
      KC=0                                                                J  53
C     INPUT CARD FIRST ACTION =99 FOR QUARTERLY TIME CHANGES.             J  54
      I=3                                                                 J  55
      IF (IN(1).NE.99) I=1                                                J  56
      NCOM(17)=I                                                          J  57
      DO 160 NJ=1,I                                                       J  58
      IF (NCOM(21).EQ.0) GO TO 170                                        J  59
      NCOM(21)=NCOM(21)+1                                                 J  60
      IF (NCOM(21).LE.12) GO TO 150                                       J  61
      NCOM(21)=1                                                          J  62
      NCOM(20)=NCOM(20)+1                                                 J  63
  150 K=NCOM(21)                                                          J  64
      NDY=NDATE(K)                                                        J  65
      NL=MONS(K)                                                          J  66
      NYR=NCOM(20)                                                        J  67
      CALL DTCONV (NDY,NL,NYR,NTIME)                                      J  68
  160 CONTINUE                                                            J  69
  170 CALL RANDOM                                                         J  70
C         ONLY ACTION 99 PERMITTED ON PERIOD CARDS                        J  71
C                                                                         J  72
C     READ NEXT CARD OF PLAYER'S INPUT                                    J  73
C                                                                         J  74
  180 READ (5,790) NO,(IN(I),I=1,9),ISCHDM,IN(11),IN(12),ISTRDM,(IN(I),I  J  75
     1=14,22)                                                             J  76
      WRITE (6,800) NO,(IN(I),I=1,9),ISCHDM,IN(11),IN(12),ISTRDM,(IN(I),  J  77
     1I=14,22)                                                            J  78
      IF (NO.NE.0) RETURN                                                 J  79
      NCODE1=IN(1)                                                        J  80
      NCODE2=IN(2)                                                        J  81
      NCODE3=IN(3)                                                        J  82
      IF ((NCODE1.GT.NCOM(5)).OR.(NCODE2.GT.NCOM(5)).OR.(NCODE3.GT.NCOM(  J  83
     15))) GO TO 200                                                      J  84
C                                                                         J  85
C     CHECK FOR PENDING PERTURBATIONS TO BE ACTIVATED                     J  86
C                                                                         J  87
      IF (IN(7).EQ.0) GO TO 190                                           J  88
      CALL SETPTB                                                         J  89
  190 DO 780 I=1,3                                                        J  90
      IF (IN(I).EQ.0) GO TO 180                                           J  91
      IF (IN(19).NE.0) GO TO 220                                          J  92
      IF (IN(8).NE.0) GO TO 220                                           J  93
C     CHECK COMPONENT ACTION FILE OVERLOAD                                J  94
      IF (KC.LT.120) GO TO 210                                            J  95
      WRITE (6,820) IN(I)                                                 J  96
      NCOM(9)=1                                                           J  97
      GO TO 780                                                           J  98
  200 K=1                                                                 J  99
      NK=2                                                                J 100
      GO TO 240                                                           J 101
  210 CONTINUE                                                            J 102
C                                                                         J 103
C     STORE ACTION AND COMPONENT NUMBERS FOR ACTION AGAINST COMPONENT     J 104
C                                                                         J 105
      KC=KC+1                                                             J 106
      NAC(1,KC)=IN(I)                                                     J 107
      NAC(2,KC)=IN(4)                                                     J 108
      IF (IN(4).EQ.0) NAC(2,KC)=1                                         J 109
      NAC(3,KC)=IN(5)                                                     J 110
      NAC(4,KC)=IN(6)                                                     J 111
      NAC(5,KC)=0                                                         J 112
      GO TO 320                                                           J 113
C                                                                         J 114
C     STORE ACTION AND ACTIVITY NUMBERS FOR ACTION AGAINST ACTIVITY       J 115
C                                                                         J 116
  220 KA=KA+1                                                             J 117
C     CHECK FOR ACTIVITY ACTION FILE OVERLOAD                             J 118
      IF (KA.GT.120) GO TO 300                                            J 119
C     SEE IF ACTIVITY NUMBER GIVEN                                        J 120
      IF (IN(8).NE.0) GO TO 280                                           J 121
      NAA(1,KA)=IN(I)                                                     J 122
C                                                                         J 123
C     CONVERT PRED&SUCC TO ACTIVITY NBR                                   J 124
C     GET THE ACTIVITY NBR FOR THE ACTIVITY DEFINED BY THE PRED AND SUCC  J 125
C      EVENT NBRS.                                                        J 126
C                                                                         J 127
      DO 230 J=1,N                                                        J 128
      IF (IN(19).NE.NACTIV(1,J)) GO TO 230                                J 129
      IF (IN(20).NE.NACTIV(2,J)) GO TO 230                                J 130
      IN(8)=NACTIV(3,J)                                                   J 131
      NK=J                                                                J 132
      GO TO 310                                                           J 133
  230 CONTINUE                                                            J 134
      NK=2                                                                J 135
      K=120                                                               J 136
C     GENERAL ERROR ROUTINE                                               J 137
  240 WRITE (6,830) NK,K                                                  J 138
      DO 250 J=I,3                                                        J 139
      WRITE (6,840) IN(J)                                                 J 140
  250 CONTINUE                                                            J 141
C     NOW ERASE THESE ACTIONS FROM "NAA"                                  J 142
C      OR 'NAC'                                                           J 143
      IF (IN(8).NE.0) GO TO 270                                           J 144
C       CLEAR COMPONENT FILE                                              J 145
      DO 260 K=1,5                                                        J 146
  260 NAC(K,KC)=0                                                         J 147
      KC=KC-1                                                             J 148
      NCOM(9)=1                                                           J 149
      GO TO 180                                                           J 150
  270 NAA(1,KA)=0                                                         J 151
      NAA(2,KA)=0                                                         J 152
      NAA(3,KA)=0                                                         J 153
      KA=KA-1                                                             J 154
      NCOM(9)=1                                                           J 155
      GO TO 180                                                           J 156
C       VERIFY THAT VALID ACTIVITY NO ENTERED ON IN(8) ON INPUT CARD      J 157
  280 DO 290 J=1,N                                                        J 158
      IF (NACTIV(3,J).EQ.IN(8)) GO TO 310                                 J 159
  290 CONTINUE                                                            J 160
C      NOT GOOD                                                           J 161
      NK=2                                                                J 162
      K=150                                                               J 163
      GO TO 240                                                           J 164
  300 WRITE (6,850) IN(I)                                                 J 165
      NCOM(9)=1                                                           J 166
      GO TO 780                                                           J 167
  310 NAA(2,KA)=NACTIV(3,J)                                               J 168
      NK=J                                                                J 169
      NAA(3,KA)=0                                                         J 170
  320 NCTN=IN(I)                                                          J 171
C     NCTN = ACTION NBR                                                   J 172
C       NCTM = ACTION CODE =NCODE IN PREEP PROGRAM                        J 173
      NCTM=NACTN(11,NCTN)                                                 J 174
C     USE ACTION CODE TO SELECT ROUTINE FOR LOGICAL EFFECT OF ACTION      J 175
      IF ((NCTM.LT.1).OR.(NCTM.GT.30)) GO TO 330                          J 176
C                                                                         J 177
      GO TO (340,350,360,370,400,410,420,450,460,470,480,510,490,500,520  J 178
     1,530,610,590,600,620,630,640,650,660,670,680,690,700,720,730), NCT  J 179
     2M                                                                   J 180
  330 K=NCTN                                                              J 181
      NK=150                                                              J 182
      GO TO 240                                                           J 183
C                                                                         J 184
C     ACTION TO INITIATE CONTRACT - ACTION CODE 1                         J 185
C                                                                         J 186
  340 CALL ACTNA (NCTN,NK,K)                                              J 187
      IF (NK.NE.0) GO TO 240                                              J 188
      IF (NACTN(11,NCODE2).EQ.2.OR.NACTN(11,NCODE3).EQ.2) GO TO 780       J 189
      NK=1                                                                J 190
      K=1                                                                 J 191
      GO TO 240                                                           J 192
C                                                                         J 193
C     ACTION TO SET START DATE - ACTION CODE 2                            J 194
C                                                                         J 195
  350 CALL ACTNB (NTIME,NK,K)                                             J 196
      IF (NK.NE.0) GO TO 240                                              J 197
      GO TO 780                                                           J 198
  360 CALL ACTNS                                                          J 199
      GO TO 780                                                           J 200
C      ACTIONS TO REQUEST REPORTS - NCODE =4                              J 201
C      FIRST CHECK THAT OTHER TWO CODES ARE ON SAME CARD                  J 202
  370 IF (NACTN(11,NCODE2).EQ.6.OR.NACTN(11,NCODE3).EQ.6) GO TO 380       J 203
      NK=5                                                                J 204
      K=IN(3)                                                             J 205
      GO TO 240                                                           J 206
  380 IF (NACTN(11,NCODE1).EQ.5.OR.NACTN(11,NCODE2).EQ.5.OR.NACTN(11,NCO  J 207
     1DE3).EQ.5) GO TO 390                                                J 208
      NK=5                                                                J 209
      K=IN(3)                                                             J 210
      GO TO 240                                                           J 211
  390 CALL ACTND (NCTN,NK,K)                                              J 212
      IF (NK.NE.0) GO TO 240                                              J 213
      IF (IN(15)) 480,780,470                                             J 214
C     ACTION TO SET REPORT LEVEL - NCODE = 5                              J 215
  400 CALL ACTNE (NCTN,NK,K)                                              J 216
      IF (NK.NE.0) GO TO 240                                              J 217
      GO TO 780                                                           J 218
C     ACTION TO SET REPORT FREQUENCY - ACTION CODE 6                      J 219
  410 CALL ACTNF (NCTN)                                                   J 220
      GO TO 780                                                           J 221
C     ACTION TO CANCEL REPORT - ACTION CODE 7                             J 222
C     FORMER ACTNG ROUTINE                                                J 223
  420 DO 430 I=1,MJOHN                                                    J 224
      IF (NTRACT(1,I).EQ.IN(4)) GO TO 440                                 J 225
  430 CONTINUE                                                            J 226
      NK=2                                                                J 227
      K=7                                                                 J 228
      GO TO 240                                                           J 229
  440 J=IN(16)                                                            J 230
      NREP(I,J)=0                                                         J 231
      GO TO 740                                                           J 232
  450 CALL ACTNH (NK,K)                                                   J 233
      IF (NK.NE.0) GO TO 240                                              J 234
      GO TO 780                                                           J 235
C     ACTION TO REQUEST FUNDS - ACTION CODE 9                             J 236
  460 CALL ACTNI (NTIME)                                                  J 237
C     ACTION TO ADD VALUE TO CONTRACT - ACTION CODE 10                    J 238
  470 CALL ACTNS                                                          J 239
      GO TO 740                                                           J 240
C     ACTION TO REDUCE CONTRACT VALUE - ACTION CODE 11                    J 241
  480 CALL ACTNS                                                          J 242
      GO TO 740                                                           J 243
C     ACTION TO ASSIGN ACTIVITY START DATE - ACTION CODE 13               J 244
  490 CALL ACTNC (NK,K)                                                   J 245
      IF (NK.NE.0) GO TO 240                                              J 246
      GO TO 780                                                           J 247
C     FUND CONTRACT - NCODE 14                                            J 248
  500 CALL ACTNJ                                                          J 249
      GO TO 780                                                           J 250
C     ACTION TO FREEZE OR UNFREEZE COMPONENT ACTION CODE 12               J 251
  510 CALL ACTNT                                                          J 252
      CALL ACTNU                                                          J 253
      GO TO 780                                                           J 254
C     ACTION TO CANCEL CONTRACT - ACTION CODE 15                          J 255
  520 J=IN(4)                                                             J 256
      IF (J.EQ.12) NREP(12,5)=0                                           J 257
      NREP(J,1)=4                                                         J 258
      NTRACT(13,J)=0                                                      J 259
      CALL ACTNN                                                          J 260
      GO TO 780                                                           J 261
C      NCODE 16 FOR A PLANNING RUN--ADDED 6/71  ROW/GSFC                  J 262
C      BACK UP TIME ONE MONTH                                             J 263
C      CANCEL RANDOM GENERATOR                                            J 264
C      PRINT OUT 533 AND PERT REPORTS ONLY                                J 265
C      C LEAR PERTURBATIONS                                               J 266
C     N.B.    THE OUTPUT TAPE ON UNIT 11 SHOULD NOT BE USED EXCEPT        J 267
C         FOR AN ADDITIONAL UPDATE OF A PLANNING RUN                      J 268
  530 NCOM(8)=NCOM(8)-1                                                   J 269
      IF (NCOM(21).GT.1) GO TO 540                                        J 270
      NCOM(21)=13                                                         J 271
      NCOM(20)=NCOM(20)-1                                                 J 272
  540 NCOM(21)=NCOM(21)-1                                                 J 273
      K=NCOM(21)                                                          J 274
      NDY=NDATE(K)                                                        J 275
      NL=MONS(K)                                                          J 276
      NYR=NCOM(20)                                                        J 277
      CALL DTCONV (NDY,NL,NYR,NTIME)                                      J 278
      NOMEGA=0                                                            J 279
      K=NCOM(4)                                                           J 280
      DO 550 J=1,K                                                        J 281
      NREP(J,2)=0                                                         J 282
      NREP(J,3)=0                                                         J 283
      NREP(J,5)=0                                                         J 284
  550 CONTINUE                                                            J 285
      K=NCOM(2)                                                           J 286
      NREP(12,5)=1                                                        J 287
      DO 560 J=1,K                                                        J 288
  560 IPERB(21,J)=0                                                       J 289
C      BACK UP COST RECORDS BY ONE MONTH                                  J 290
      DO 570 JJ=1,N                                                       J 291
      DO 570 KK=33,37                                                     J 292
  570 NACTIV(KK+13,JJ)=NACTIV(KK,JJ)                                      J 293
      J=NCOM(3)                                                           J 294
      DO 580 JJ=1,J                                                       J 295
      DO 580 KK=38,42                                                     J 296
  580 NCOMP(KK+5,JJ)=NCOMP(KK,JJ)                                         J 297
      GO TO 740                                                           J 298
C      FORMER CODE 19 ROUTINE DELETED                                     J 299
  590 GO TO 780                                                           J 300
  600 GO TO 780                                                           J 301
C      CODES 17,20,21 STORE IN NACTIV 53   - FORWAR DETERMINES TIME       J 302
C                     AND COST CHANGES VIA THE NCODE                      J 303
  610 CONTINUE                                                            J 304
  620 CONTINUE                                                            J 305
  630 IF (IN(22).LT.-15) IN(22)=-15                                       J 306
      IF (IN(22).GT.15) IN(22)=15                                         J 307
      NACTIV(53,NK)=IN(22)                                                J 308
      GO TO 780                                                           J 309
  640 CALL ACTNX (NCTN)                                                   J 310
      GO TO 740                                                           J 311
C     ACTION TO CHANGE PROJECT BUDGET BIN - NCODE 23                      J 312
  650 NCOM(19)=NCOM(19)+IN(15)                                            J 313
      GO TO 740                                                           J 314
  660 CALL ACTNY                                                          J 315
      GO TO 780                                                           J 316
C     STATEMENTS 525-528 ARE SPECIAL PERTURBATIONS FOR OOO PROJECT        J 317
C     ACTION TO START PERTURBATION 11 - NCODE 25                          J 318
  670 IN(7)=11                                                            J 319
      GO TO 710                                                           J 320
C     ACTION TO START PERTURBATION 20 - NCODE 26                          J 321
  680 IN(7)=20                                                            J 322
      GO TO 710                                                           J 323
C     ACTION TO START PERTURBATION 34 - NCODE 27                          J 324
  690 IN(7)=34                                                            J 325
      GO TO 710                                                           J 326
C     ACTION TO START PERTURBATION 35 - NCODE 28                          J 327
  700 IN(7)=35                                                            J 328
  710 CALL SETPTB                                                         J 329
      GO TO 780                                                           J 330
C     ACTION TO DELETE AN ACTIVITY NCODE = 29                             J 331
  720 CALL PACK (0,15,NK)                                                 J 332
      GO TO 760                                                           J 333
C     ACTION TO RESTORE AN ACTIVITY NCODE = 30                            J 334
  730 CALL PACK (1,15,NK)                                                 J 335
      GO TO 760                                                           J 336
C      ACTIONS NOT REQUIRING EFFECTS FILES,CLEAR KA OR KC                 J 337
  740 IF (IN(8).NE.0) GO TO 760                                           J 338
      DO 750 K=1,5                                                        J 339
  750 NAC(K,KC)=0                                                         J 340
      KC=KC-1                                                             J 341
      GO TO 780                                                           J 342
  760 DO 770 K=1,3                                                        J 343
  770 NAA(K,KA)=0                                                         J 344
      KA=KA-1                                                             J 345
  780 CONTINUE                                                            J 346
      GO TO 180                                                           J 347
C                                                                         J 348
  790 FORMAT (I1,3I3,I2,2I1,I2,I3,I2,A3,2I2,A3,I2,I6,3I2,2I4,I2,I5)       J 349
  800 FORMAT (14H0INPUT CARD   ,I1,4I5,2I2,I4,1X,I4,I4,1X,A3,I3,I4,1X,A3  J 350
     1,I3,4X,I6,3I4,2X,I4,2X,I4,I4,2X,I4)                                 J 351
  810 FORMAT ('  ERROR 237,INPUT PERIOD',I4,' CORRECTED TO',I3)           J 352
  820 FORMAT (2X,' ** COMPONENT ACTION FILE EXCEEDED, ACTION NO. ',I3,'   J 353
     1IGNORED')                                                           J 354
  830 FORMAT (4X,'ERROR',I4,'/',I3)                                       J 355
  840 FORMAT (6X,'ACTION',I4,' BYPASSED')                                 J 356
  850 FORMAT (2X,'  ** ACTIVITY ACTION FILE EXCEEDED, ACTION NO. ',I3,'   J 357
     1IGNORED')                                                           J 358
      END                                                                 J 359-
      SUBROUTINE ACTNU                                                    K   1
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        K   2
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  K   3
     120),NAC(5,120)                                                      K   4
      COMMON MONS(12)                                                     K   5
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  K   6
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     K   7
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  K   8
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                K   9
      INTEGER*2 NRSYS,NRCMP,NMBRCM,I,K,NRCTR,NCON                         K  10
C     THIS ROUTINE REMOVES FROZEN COMPONENT COSTS FROM THE CONTRACT.      K  11
      NRSYS=0                                                             K  12
      NMBRCM=0                                                            K  13
      NRCMP=NCOM(3)                                                       K  14
      DO 150 IO=1,NRCMP                                                   K  15
      IF (IN(4).EQ.NCOMP(1,IO).AND.NCOMP(2,IO).EQ.0.AND.NCOMP(3,IO).EQ.0  K  16
     1) GO TO 110                                                         K  17
      IF (IN(4).EQ.NCOMP(1,IO).AND.IN(5).EQ.NCOMP(2,IO)) GO TO 120        K  18
      GO TO 150                                                           K  19
  110 NRCTR=IO                                                            K  20
      GO TO 150                                                           K  21
  120 IF (NCOMP(3,IO).EQ.IN(6).AND.IN(6).NE.0) GO TO 140                  K  22
      IF (NCOMP(3,IO).EQ.0) GO TO 130                                     K  23
      GO TO 150                                                           K  24
  130 NRSYS=IO                                                            K  25
      GO TO 150                                                           K  26
  140 NMBRCM=IO                                                           K  27
  150 CONTINUE                                                            K  28
      NCON=IN(4)                                                          K  29
      IF (IN(4).GT.1) GO TO 170                                           K  30
      DO 160 I=1,5                                                        K  31
      K=10+I                                                              K  32
      NCOMP(K,NRCTR)=NCOMP(K,NRCTR)-NCOMP(K,NMBRCM)                       K  33
  160 NCOMP(K,NRSYS)=NCOMP(K,NRSYS)-NCOMP(K,NMBRCM)                       K  34
      GO TO 190                                                           K  35
  170 DO 180 I=1,5                                                        K  36
      K=10+I                                                              K  37
      NCOMP(K,NRCTR)=NCOMP(K,NRCTR)-NCOMP(K,NRSYS)                        K  38
  180 NCOMP(K,NRSYS)=0                                                    K  39
  190 NTRACT(9,NCON)=NCOMP(11,NRCTR)                                      K  40
      RETURN                                                              K  41
      END                                                                 K  42-
      SUBROUTINE SETPTB                                                   L   1
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  L   2
     1                                                                    L   3
      DIMENSION ACTN(16,120)                                              L   4
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        L   5
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  L   6
     120),NAC(5,120)                                                      L   7
      COMMON MONS(12)                                                     L   8
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  L   9
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     L  10
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  L  11
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                L  12
      INTEGER*2 NP,I                                                      L  13
      NP=NCOM(2)                                                          L  14
      DO 110 I=1,NP                                                       L  15
      IF (IPERB(1,I).EQ.IN(7)) GO TO 120                                  L  16
  110 CONTINUE                                                            L  17
      WRITE (6,150) IN(7)                                                 L  18
      RETURN                                                              L  19
  120 IF (IPERB(21,I).EQ.0) GO TO 130                                     L  20
      IPERB(21,I)=0                                                       L  21
      GO TO 140                                                           L  22
  130 IPERB(21,I)=1                                                       L  23
  140 RETURN                                                              L  24
C                                                                         L  25
  150 FORMAT (11H0--ERROR-10,I5)                                          L  26
      END                                                                 L  27-
      SUBROUTINE RANDOM                                                   M   1
      COMMON MONS(12)                                                     M   2
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  M   3
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     M   4
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  M   5
     1A,KC                                                                M   6
      DIMENSION M(10)                                                     M   7
      DATA M/90,80,45,70,60,50,40,60,40,80/                               M   8
C      THE LARGER THE RETURNED VALUE,THE MORE ACTIVITIES WILL BE CHANGED  M   9
C      SELECTION IS BASED ON THE PLAY PERIOD NUMBER                       M  10
      N=NCOM(8)                                                           M  11
  110 IF (N.GT.10) GO TO 120                                              M  12
      NCOM(14)=M(N)*100                                                   M  13
C      ONLY NCOM14 IS NOW USED,FORMERLY NCOM 13,12,AND17 WERE RANDOM NO   M  14
      RETURN                                                              M  15
  120 N=N-10                                                              M  16
      GO TO 110                                                           M  17
      END                                                                 M  18-
      SUBROUTINE ACTNX (NCTN)                                             N   1
C       ACTNX CHANGES TIME PROBABILITY IF NACTN(2,NCTN) .NE. ZERO         N   2
C                          IN COST PROBABILITY IF NACTN(3,NCTN) NE 0      N   3
C                  CHANGES IN REL. PROBABILITY IF NACTN(4,NCTN) NE 0      N   4
C     THIS SUBROUTINE ADDED TO GREMEX SYSTEM BY WOLF R + D CORP. 5-70     N   5
C     THE DELTA DURATION FIELD ON THE GREMEX PLAYER CARD IS USED FOR      N   6
C     SPECIFIC INCREASE OR DECREASE IN PROBABILITY FOR ALL FUTURE         N   7
C     ACTIVITIES AGAINST A CONTRACT AND OR SYSTEM AND OR SUBSYSTEM.       N   8
C     THIS SUBROUTINE SHALL BE REFERRED TO AS THE TCP LIBRARY.            N   9
C                                                                         N  10
C     MACTV = IN(8) = ACTIVITY NO. FROM PLAYER INPUT CARD.                N  11
C             IF MACTV NOT ZERO THEN ONLY THAT SPECIFIC ACTIVITY IS TO    N  12
C             BE AFFECTED BY THE CHANGE IN PROBABILITIES.                 N  13
C     LWRDC = IN(4) = CONTRACT NO. FROM PLAYER INPUT CARD.                N  14
C     MWRDC = IN(5) = SYSTEM NO.   FROM PLAYER INPUT CARD.                N  15
C     NWRDC = IN(6) = SUBSYSTEM NO.FROM PLAYER INPUT CARD.                N  16
C     ICHNG = IN(22)= + OR - CHANGE IN PROBABILITY FROM DELTA DURATION    N  17
C                            FIELD ON PLAYER INPUT CARD.                  N  18
C                                                                         N  19
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  N  20
     1                                                                    N  21
      DIMENSION ACTN(16,120)                                              N  22
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        N  23
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  N  24
     120),NAC(5,120)                                                      N  25
      COMMON MONS(12)                                                     N  26
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  N  27
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     N  28
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  N  29
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                N  30
      INTEGER*2 LWRDC,MWRDC,NWRDC,ICHNG,JWRDC,KWRDC,IWRDC,NCTN,MACTV      N  31
      LWRDC=IN(4)                                                         N  32
      MWRDC=IN(5)                                                         N  33
      NWRDC=IN(6)                                                         N  34
      MACTV=IN(8)                                                         N  35
      ICHNG=IN(22)                                                        N  36
      DO 150 KWRDC=1,N                                                    N  37
      IF (MACTV.EQ.NACTIV(3,KWRDC)) GO TO 110                             N  38
      IF (MACTV.NE.0) GO TO 150                                           N  39
      IF (LWRDC.EQ.NACTIV(4,KWRDC).AND.MWRDC.EQ.NACTIV(5,KWRDC).AND.NWRD  N  40
     1C.EQ.NACTIV(6,KWRDC)) GO TO 110                                     N  41
      IF (LWRDC.EQ.NACTIV(4,KWRDC).AND.MWRDC.EQ.NACTIV(5,KWRDC).AND.NWRD  N  42
     1C.EQ.0) GO TO 110                                                   N  43
      IF (LWRDC.EQ.NACTIV(4,KWRDC).AND.MWRDC.EQ.0.AND.NWRDC.EQ.0) GO TO   N  44
     1110                                                                 N  45
      GO TO 150                                                           N  46
  110 DO 140 IWRDC=2,4                                                    N  47
      JWRDC=IWRDC+36                                                      N  48
      IF (NACTN(IWRDC,NCTN).EQ.0) GO TO 140                               N  49
      NACTIV(JWRDC,KWRDC)=NACTIV(JWRDC,KWRDC)+(ICHNG*(NACTN(IWRDC,NCTN)/  N  50
     1NACTN(IWRDC,NCTN)))                                                 N  51
      IF (NACTIV(JWRDC,KWRDC).LT.1) GO TO 120                             N  52
      IF (NACTIV(JWRDC,KWRDC).GT.99) GO TO 130                            N  53
      GO TO 140                                                           N  54
  120 NACTIV(JWRDC,KWRDC)=1                                               N  55
      GO TO 140                                                           N  56
  130 NACTIV(JWRDC,KWRDC)=99                                              N  57
  140 CONTINUE                                                            N  58
  150 CONTINUE                                                            N  59
      RETURN                                                              N  60
      END                                                                 N  61-
      SUBROUTINE ACTNY                                                    O   1
C      ACTNY CONVERTS THE DOLLAR TOTAL FROM COL.36-39 OF PLAYER'S CARD    O   2
C        TO PERCENTAGE COST CHANGE AND STORES IN NAC(5)--                 O   3
C       OR IF JUST ON ONE ACTIVITY STORES DOLLAR VALUE IN NAA(3)          O   4
C     "FORWAR" WILL THEN CHANGE COSTS WITHOUT TIME CHANGE                 O   5
C     THE ACTUAL TOTAL AMOUNT IS SPREAD OUT OVER ENG. COSTS, MAT. COSTS,  O   6
C     TECH. COSTS, AND SUBCONTRACT COSTS, AND TOTAL COSTS ARE UPDATED.    O   7
C     THIS ACTION CAN BE AGAINST A SPECIFIC ACTIVITY OR AN ENTIRE         O   8
C     CONTRACT , SYSTEM OR SUBSYSTEM........                              O   9
C     THIS SUBROUTINE WAS ADDED BY WOLF R+D CORP. IN JULY 1970.........   O  10
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  O  11
     1                                                                    O  12
      DIMENSION ACTN(16,120)                                              O  13
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        O  14
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  O  15
     120),NAC(5,120)                                                      O  16
      COMMON MONS(12)                                                     O  17
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  O  18
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     O  19
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  O  20
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                O  21
      INTEGER*2 LWRDC,MWRDC,NWRDC,ICHNG,JWRDC,KWRDC,IWRDC,NCTN,MACTV      O  22
      IF (IN(22).NE.0) RETURN                                             O  23
      IF (IN(15).EQ.0) RETURN                                             O  24
      IF (IN(8).NE.0) GO TO 130                                           O  25
      LWRDC=IN(4)                                                         O  26
      MWRDC=IN(5)                                                         O  27
      NWRDC=IN(6)                                                         O  28
      CHNG=IN(15)                                                         O  29
      DO 110 JA=1,50                                                      O  30
      IF (LWRDC.EQ.NCOMP(1,JA).AND.MWRDC.EQ.NCOMP(2,JA).AND.NWRDC.EQ.NCO  O  31
     1MP(3,JA)) GO TO 120                                                 O  32
      IF (LWRDC.EQ.NCOMP(1,JA).AND.MWRDC.EQ.NCOMP(2,JA).AND.NWRDC.EQ.0)   O  33
     1GO TO 120                                                           O  34
      IF (LWRDC.EQ.NCOMP(1,JA).AND.MWRDC.EQ.0.AND.NWRDC.EQ.0) GO TO 120   O  35
  110 CONTINUE                                                            O  36
      RETURN                                                              O  37
  120 TVALUE=NCOMP(11,JA)                                                 O  38
      IF (TVALUE.EQ.0.0) TVALUE=CHNG                                      O  39
      NAC(5,KC)=(CHNG/TVALUE)*100.0+0.5                                   O  40
      RETURN                                                              O  41
  130 NAA(3,KA)=IN(22)                                                    O  42
      RETURN                                                              O  43
      END                                                                 O  44-
      SUBROUTINE ACTNA (NCTN,NK,K)                                        P   1
C     ACTNA INITIATES CONTRACTS. CHECKS THAT THE ACTION CALLED IS         P   2
C     PROPER TO INITIATE SPECIFIED CONTRACT. IF NOT, WRITES ERROR 1.      P   3
C     SETS EXISTENCE INDICATORS FOR PERTINENT ACTIVITIES.                 P   4
C     NK,K ARE ERROR RETURNS                                              P   5
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  P   6
     1                                                                    P   7
      DIMENSION ACTN(16,120)                                              P   8
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        P   9
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  P  10
     120),NAC(5,120)                                                      P  11
      COMMON MONS(12)                                                     P  12
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  P  13
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     P  14
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  P  15
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                P  16
      INTEGER*2 NCTN,I,J,K,JA,KATE,NK                                     P  17
      EQUIVALENCE (J,NCOM(1))                                             P  18
C     CHECK INPUT CONTRACT NBR                                            P  19
      IN4=IN(4)                                                           P  20
      IF (IN(4).NE.NACTN(16,NCTN)) GO TO 130                              P  21
C     CHECK ALL ACTIVITIES AND SET EXISTANCE IND FOR NON-PERTURBATION     P  22
C     ACTIVITIES OF INPUT CONTRACT NBR.                                   P  23
      DO 110 I=1,J                                                        P  24
      IF (IN(4).NE.NACTIV(4,I)) GO TO 110                                 P  25
      IF (NACTIV(7,I).NE.0) GO TO 110                                     P  26
      CALL PACK (1,15,I)                                                  P  27
  110 CONTINUE                                                            P  28
C     FIND CONTRACT INFORMATION                                           P  29
      K=NCOM(4)                                                           P  30
      DO 120 I=1,K                                                        P  31
      IF (IN(4).EQ.NTRACT(1,I)) GO TO 140                                 P  32
  120 CONTINUE                                                            P  33
C     SPECIFIED CONTRACT NOT IN CONTRACT FILE                             P  34
      K=IN(4)                                                             P  35
      NK=20                                                               P  36
      RETURN                                                              P  37
  130 K=IN(4)                                                             P  38
      NK=1                                                                P  39
      RETURN                                                              P  40
C     OVERHEAD FOR CONTRACTOR SPECIFIED(BY MEANS OF ACTION) ESTABLISHED   P  41
C      IN THE CONTRACT                                                    P  42
  140 NTRACT(5,I)=NACTN(15,NCTN)                                          P  43
C      SET CONTRACT INITIATED INDICATOR TO TYPE OF CONTRACT               P  44
C      1=CPFF, 2=CPAF, 3=CPIF, 4=FFP, 5= COST                             P  45
      KATE=IN(2)                                                          P  46
C      FIND CONTRACT TYPE ACTION                                          P  47
      IF (NACTN(11,KATE).EQ.2) KATE=IN(3)                                 P  48
      NTRACT(13,I)=NACTN(16,KATE)                                         P  49
C      DEFAULT PROC.                                                      P  50
      IF (NTRACT(13,I).LE.0.OR.NTRACT(13,I).GT.5) NTRACT(13,I)=1          P  51
      NK=0                                                                P  52
      RETURN                                                              P  53
      END                                                                 P  54-
      SUBROUTINE ACTNB (NTIME,NK,K)                                       Q   1
C     ACTNB SETS START DATES.  IF FIRST TIME START DATE HAS BEEN SET BY   Q   2
C     THIS PLAYER, SETS UP NCOM(10),NCOM(11),NCOM(19),NCOM(23),NCOM(24),  Q   3
C     NTIME.  SETS START DATE WEEKS FROM ORIGIN INTO COMPONENT AND        Q   4
C     CONTRACT FILES.  IF FIRST TIME, THIS IS ZERO.  IF FIRST TIME AND    Q   5
C     INPUT COMPONENT IS NOT CONTRACT, CALLS ERROR(31,1).                 Q   6
C     IF INPUT START DATE NOT VALID, CALLS ERROR(3,1) FOR                 Q   7
C     MISSING DAY, (3,2) FOR ZERO MONTH, (3,3) FOR BLANK MONTH, (3,4)     Q   8
C     FOR MISSING YEAR, (3,5) FOR INVALID MONTH NAME, (3,6) FOR INVALID   Q   9
C     DAY.                                                                Q  10
C     NK,K ARE ERROR RETURNS                                              Q  11
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        Q  12
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  Q  13
     120),NAC(5,120)                                                      Q  14
      COMMON MONS(12)                                                     Q  15
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  Q  16
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     Q  17
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  Q  18
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                Q  19
      INTEGER*2 I,J,NC,NK,NDT,MPASS,NBIT,NHIT,N,NTIME,K                   Q  20
      DATA IBLNK/4H    /                                                  Q  21
      IF (IN(12).EQ.0) GO TO 130                                          Q  22
      IF (ISTRDM.EQ.0) GO TO 140                                          Q  23
      IF (ISTRDM.EQ.IBLNK) GO TO 150                                      Q  24
      IF (IN(14).EQ.0) GO TO 160                                          Q  25
C     FIRST TIME THRU ?                                                   Q  26
      IF (NCOM(20).NE.0) GO TO 110                                        Q  27
C     YES, START DATE MUST BE SET FOR CONTRACT ONLY. ESTABLISH YEAR OF    Q  28
C      CONTRACT ORIGIN                                                    Q  29
      IF (IN(5).NE.0) GO TO 180                                           Q  30
      NCOM(11)=IN(14)                                                     Q  31
C     NON-FIRST TIME THRU ENTER HERE. CALCULATE WEEK OF CONTRACT ORIGIN   Q  32
C      IN 10THS FROM BEGINNING OF CONTRACT YEAR                           Q  33
  110 NC=IN(12)                                                           Q  34
      NL=ISTRDM                                                           Q  35
      NK=IN(14)                                                           Q  36
      CALL DTCONV (NC,NL,NK,NDT)                                          Q  37
      IF (NCOM(20).NE.0) GO TO 280                                        Q  38
      NCOM(10)=NDT                                                        Q  39
      NDT=0                                                               Q  40
      NCOM(20)=IN(14)                                                     Q  41
      DO 120 I=1,12                                                       Q  42
      J=I                                                                 Q  43
      IF (ISTRDM.EQ.MONS(I)) GO TO 250                                    Q  44
  120 CONTINUE                                                            Q  45
C     ERROR RETURNS                                                       Q  46
      K=5                                                                 Q  47
      GO TO 170                                                           Q  48
  130 K=1                                                                 Q  49
      GO TO 170                                                           Q  50
  140 K=2                                                                 Q  51
      GO TO 170                                                           Q  52
  150 K=3                                                                 Q  53
      GO TO 170                                                           Q  54
  160 K=4                                                                 Q  55
  170 NK=3                                                                Q  56
      RETURN                                                              Q  57
  180 NK=31                                                               Q  58
      K=1                                                                 Q  59
      RETURN                                                              Q  60
  190 NK=5                                                                Q  61
  200 K=IN(4)                                                             Q  62
      RETURN                                                              Q  63
  210 NK=7                                                                Q  64
      GO TO 200                                                           Q  65
  220 NK=4                                                                Q  66
      GO TO 200                                                           Q  67
  230 NK=6                                                                Q  68
      GO TO 200                                                           Q  69
  240 K=6                                                                 Q  70
      GO TO 170                                                           Q  71
  250 IF (IN(12).GT.NDAYS(J)) GO TO 240                                   Q  72
      DO 260 I=1,12                                                       Q  73
      NDATE(I)=IN(12)                                                     Q  74
      IF (IN(12).GT.NDAYS(I)) NDATE(I)=NDAYS(I)                           Q  75
  260 CONTINUE                                                            Q  76
      NCOM(16)=J                                                          Q  77
      NCOM(21)=J+1                                                        Q  78
      IF (NCOM(21).LE.12) GO TO 270                                       Q  79
      NCOM(21)=1                                                          Q  80
      NCOM(20)=NCOM(20)+1                                                 Q  81
  270 J=NCOM(21)                                                          Q  82
      NC=NDATE(J)                                                         Q  83
      NL=MONS(J)                                                          Q  84
      MPASS=NCOM(20)                                                      Q  85
      CALL DTCONV (NC,NL,MPASS,NTIME)                                     Q  86
  280 N=NCOM(1)                                                           Q  87
      NHIT=0                                                              Q  88
      DO 330 I=1,N                                                        Q  89
C     ANY INPUT ACTION COMPONENT NBR WILL AFFECT ACTIVITIES OF THAT       Q  90
C      COMPONENT AND ALL ACTIVITIES OF ANY COMPONENT BELOW IT IN HIERAR-  Q  91
C      CHY  100 GT 110 GT 117(CONTRACT,SYSTEM,SUBSYSTEM INDICATIONS)      Q  92
      IF (IN(4).NE.NACTIV(4,I)) GO TO 330                                 Q  93
      IF (IN(5).NE.NACTIV(5,I)) GO TO 290                                 Q  94
      IF (IN(6).EQ.NACTIV(6,I)) GO TO 300                                 Q  95
      IF (IN(6).EQ.0) GO TO 300                                           Q  96
      GO TO 330                                                           Q  97
  290 IF (IN(5).NE.0) GO TO 330                                           Q  98
  300 IF (NACTIV(7,I).NE.0) GO TO 310                                     Q  99
      CALL UNPAK (NBIT,15,I)                                              Q 100
      IF (NBIT.GE.0) GO TO 220                                            Q 101
      GO TO 320                                                           Q 102
  310 CALL UNPAK (NBIT,15,I)                                              Q 103
      IF (NBIT.GE.0) GO TO 330                                            Q 104
  320 CALL UNPAK (NBIT,11,I)                                              Q 105
      IF (NBIT.GE.0) GO TO 330                                            Q 106
      CALL PACK (1,7,I)                                                   Q 107
      NHIT=1                                                              Q 108
  330 CONTINUE                                                            Q 109
      IF (NHIT.EQ.0) GO TO 190                                            Q 110
      N=NCOM(3)                                                           Q 111
      NHIT=0                                                              Q 112
      DO 360 I=1,N                                                        Q 113
C     ANY INPUT ACTION COMPONENT NBR WILL AFFECT MATCHING COMPONENT AND   Q 114
C      ALL COMPONENTS BELOW IT IN HIERARCHY. SEE ABOVE                    Q 115
      IF (IN(4).NE.NCOMP(1,I)) GO TO 360                                  Q 116
      IF (IN(5).NE.NCOMP(2,I)) GO TO 340                                  Q 117
      IF (IN(6).EQ.NCOMP(3,I)) GO TO 350                                  Q 118
      IF (IN(6).EQ.0) GO TO 350                                           Q 119
      GO TO 360                                                           Q 120
  340 IF (IN(5).NE.0) GO TO 360                                           Q 121
  350 NCOMP(48,I)=NDT                                                     Q 122
      NHIT=1                                                              Q 123
  360 CONTINUE                                                            Q 124
      IF (NHIT.EQ.0) GO TO 230                                            Q 125
      IF (IN(5).NE.0) GO TO 390                                           Q 126
      N=NCOM(4)                                                           Q 127
      DO 370 I=1,N                                                        Q 128
      J=I                                                                 Q 129
      IF (IN(4).EQ.NTRACT(1,I)) GO TO 380                                 Q 130
  370 CONTINUE                                                            Q 131
      GO TO 210                                                           Q 132
  380 NTRACT(2,J)=NDT                                                     Q 133
  390 NK=0                                                                Q 134
      RETURN                                                              Q 135
      END                                                                 Q 136-
      SUBROUTINE ACTNC (NK,K)                                             R   1
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  R   2
     1                                                                    R   3
      DIMENSION ACTN(16,120)                                              R   4
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        R   5
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  R   6
     120),NAC(5,120)                                                      R   7
      COMMON MONS(12)                                                     R   8
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  R   9
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     R  10
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  R  11
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                R  12
      INTEGER*2 I,NBIT,NC,NK,NDT,K                                        R  13
      DO 110 I=1,N                                                        R  14
      CALL UNPAK (NBIT,15,I)                                              R  15
      IF (NBIT.GE.0) GO TO 110                                            R  16
      IF (IN(19).NE.NACTIV(1,I)) GO TO 110                                R  17
      IF (IN(20).NE.NACTIV(2,I)) GO TO 110                                R  18
      NC=IN(12)                                                           R  19
      NL=ISTRDM                                                           R  20
      NK=IN(14)                                                           R  21
      CALL DTCONV (NC,NL,NK,NDT)                                          R  22
C     THIS METHOD USED TO PRESERVE THE SIGN IN FORTRAN.                   R  23
      ITEMP1=NDT                                                          R  24
      ITEMP2=NACTIV(52,I)                                                 R  25
      NACTIV(52,I)=ISIGN(ITEMP1,ITEMP2)                                   R  26
      NK=0                                                                R  27
      RETURN                                                              R  28
  110 CONTINUE                                                            R  29
      NK=103                                                              R  30
      K=IN(19)                                                            R  31
      RETURN                                                              R  32
      END                                                                 R  33-
      SUBROUTINE ACTND (NCTN,NK,L)                                        S   1
C     REPORT REQUEST ROUTINE                                              S   2
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  S   3
     1                                                                    S   4
      DIMENSION ACTN(16,120)                                              S   5
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        S   6
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  S   7
     120),NAC(5,120)                                                      S   8
      COMMON MONS(12)                                                     S   9
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  S  10
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     S  11
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  S  12
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                S  13
      INTEGER*2 IN2,IN3,JA,JC                                             S  14
      INTEGER*2 NCTN,IN4,J,I,K,NK                                         S  15
      INTEGER*2 L                                                         S  16
      EQUIVALENCE (JC,NCOM(3))                                            S  17
      EQUIVALENCE (IN(4),IN4), (NCOM(4),J), (K,IN(16))                    S  18
C     CHECK START CARD INPUT VALUES                                       S  19
      NK=2                                                                S  20
      IF (IN(16).NE.NACTN(16,NCTN)) GO TO 120                             S  21
      DO 110 I=1,J                                                        S  22
      IF (NTRACT(1,I).EQ.IN4) GO TO 130                                   S  23
  110 CONTINUE                                                            S  24
      L=41                                                                S  25
      RETURN                                                              S  26
  120 L=4                                                                 S  27
      RETURN                                                              S  28
  130 IF (NREP(I,K).LT.0) GO TO 140                                       S  29
      NREP(I,K)=1                                                         S  30
      GO TO 150                                                           S  31
  140 NREP(I,K)=-1                                                        S  32
C      COMPUTE COSTS FOR REPORT REQUESTED BY THIS CARD                    S  33
  150 IN2=IN(2)                                                           S  34
      IN3=IN(3)                                                           S  35
      DO 160 JA=1,JC                                                      S  36
      IF (IN4.EQ.NCOMP(1,JA)) GO TO 170                                   S  37
  160 CONTINUE                                                            S  38
      L=5                                                                 S  39
      RETURN                                                              S  40
C      IF CONTRACT NOT YET AWARDED USE 100 FOR OVHD                       S  41
  170 IF (NTRACT(13,I).LE.0) NTRACT(5,I)=100                              S  42
C      DO COMPUTATIONS IN FLOAT MODE                                      S  43
      BASE=NCOMP(11,JA)                                                   S  44
      OVHD=NTRACT(5,I)                                                    S  45
      SUM=NACTN(13,NCTN)+NACTN(13,IN2)+NACTN(13,IN3)                      S  46
      COST=(BASE*OVHD*SUM)/10000.0                                        S  47
      IN(15)=COST                                                         S  48
      WRITE (6,180) IN(15),IN4                                            S  49
C      NOW GO ADD THESE COSTS TO CONTRACT AWARD VALUE                     S  50
C      NOW RESET NTRACT5 IF NEEDED                                        S  51
      IF (NTRACT(13,I).LE.0) NTRACT(5,I)=0                                S  52
      NK=0                                                                S  53
      RETURN                                                              S  54
C                                                                         S  55
  180 FORMAT (2X,'* NOTE- REPORT COSTS OF ',I5,'K ADDED TO CONTRACT NO',  S  56
     1I3,/)                                                               S  57
      END                                                                 S  58-
      SUBROUTINE ACTNE (NCTN,NK,L)                                        T   1
C     ROUTINE TO SET LEVEL OF REPORTS                                     T   2
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  T   3
     1                                                                    T   4
      DIMENSION ACTN(16,120)                                              T   5
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        T   6
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  T   7
     120),NAC(5,120)                                                      T   8
      COMMON MONS(12)                                                     T   9
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  T  10
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     T  11
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  T  12
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                T  13
      INTEGER*2 NCTN,I,J,K,NK                                             T  14
      INTEGER*2 L                                                         T  15
      EQUIVALENCE (I,NCOM(4)), (K,IN(16))                                 T  16
      NK=2                                                                T  17
      DO 110 J=1,I                                                        T  18
      IF (NTRACT(1,J).EQ.IN(4)) GO TO 130                                 T  19
  110 CONTINUE                                                            T  20
      L=5                                                                 T  21
      GO TO 150                                                           T  22
  120 L=51                                                                T  23
      GO TO 150                                                           T  24
  130 IF (NREP(J,K).EQ.0) GO TO 120                                       T  25
      IF (NREP(J,K).LT.0) GO TO 140                                       T  26
      NREP(J,K)=IABS(NACTN(16,NCTN))                                      T  27
      GO TO 150                                                           T  28
  140 NREP(J,K)=-NACTN(16,NCTN)                                           T  29
  150 NK=0                                                                T  30
      RETURN                                                              T  31
      END                                                                 T  32-
      SUBROUTINE ACTNF (NCTN,NK,L)                                        U   1
C     ROUTINE TO SET FREQUENCY OF REPORTS                                 U   2
C     SETS NRIP + FOR MONTHLY, - FOR QUARTERLY                            U   3
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  U   4
     1                                                                    U   5
      DIMENSION ACTN(16,120)                                              U   6
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        U   7
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  U   8
     120),NAC(5,120)                                                      U   9
      COMMON MONS(12)                                                     U  10
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  U  11
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     U  12
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  U  13
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                U  14
      INTEGER*2 NCTN,I,J,K,NK                                             U  15
      INTEGER*2 L                                                         U  16
      EQUIVALENCE (I,NCOM(4)), (K,IN(16))                                 U  17
      NK=2                                                                U  18
      DO 110 J=1,I                                                        U  19
      IF (NTRACT(1,J).EQ.IN(4)) GO TO 120                                 U  20
  110 CONTINUE                                                            U  21
      L=6                                                                 U  22
      GO TO 130                                                           U  23
C     SEE IF REQUESTED YET                                                U  24
  120 IF (NREP(J,K).EQ.0) GO TO 140                                       U  25
C     IF ALREADY REQUESTED,MAKE POSITIVE                                  U  26
      IF (NREP(J,K).LT.0) NREP(J,K)=-NREP(J,K)                            U  27
C     NACTN(16)=(C/R/L OF ACTION) IS 1 FOR QUARTERLY, 0 FOR MONTHLY       U  28
      IF (NACTN(16,NCTN).EQ.1) NREP(J,K)=-NREP(J,K)                       U  29
      NK=0                                                                U  30
  130 RETURN                                                              U  31
  140 L=61                                                                U  32
      GO TO 130                                                           U  33
      END                                                                 U  34-
      SUBROUTINE ACTNH (NK,K)                                             V   1
C     ROUTINE TO SET SCHEDULE DATES                                       V   2
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  V   3
     1                                                                    V   4
      DIMENSION ACTN(16,120)                                              V   5
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        V   6
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  V   7
     120),NAC(5,120)                                                      V   8
      COMMON MONS(12)                                                     V   9
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  V  10
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     V  11
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  V  12
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                V  13
      INTEGER*2 IN1,NDT,IN3,I,J,K,NK                                      V  14
      EQUIVALENCE (IN1,IN(9)), (IN2,ISCHDM), (IN3,IN(11)), (J,NCOM(3))    V  15
      DATA IBLNK/4H    /                                                  V  16
      NK=2                                                                V  17
      IF (IN(9).EQ.0) GO TO 130                                           V  18
      IF (ISCHDM.EQ.IBLNK) GO TO 130                                      V  19
      IF (ISCHDM.EQ.0) GO TO 130                                          V  20
      IF (IN(11).EQ.0) GO TO 130                                          V  21
      IF (NCOM(11).EQ.0) GO TO 140                                        V  22
      CALL DTCONV (IN1,IN2,IN3,NDT)                                       V  23
      IF (IN(4).EQ.1) GO TO 150                                           V  24
      DO 110 I=1,J                                                        V  25
      IF (IN(4).EQ.NCOMP(1,I).AND.IN(5).EQ.NCOMP(2,I).AND.IN(6).EQ.NCOMP  V  26
     1(3,I)) GO TO 120                                                    V  27
  110 CONTINUE                                                            V  28
      K=83                                                                V  29
      GO TO 160                                                           V  30
  120 NCOMP(10,I)=NDT                                                     V  31
      NK=0                                                                V  32
      GO TO 160                                                           V  33
  130 K=81                                                                V  34
      GO TO 160                                                           V  35
  140 K=82                                                                V  36
      GO TO 160                                                           V  37
  150 NTRACT(3,1)=NDT                                                     V  38
      NK=0                                                                V  39
  160 RETURN                                                              V  40
      END                                                                 V  41-
      SUBROUTINE ACTNI (NTIME)                                            W   1
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  W   2
     120),NAC(5,120)                                                      W   3
      COMMON MONS(12)                                                     W   4
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  W   5
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     W   6
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  W   7
     1A,KC,IPERB,NDIST,IN,NAA,NAC                                         W   8
      INTEGER*2 INCN,NOCN,NALPHA,NDOLL,I,J,NDSC,NTIME,NCONST,NCI          W   9
C     ACTNI HANDLES REQUESTS FOR CONTRACT FUNDS                           W  10
      J=IN(4)                                                             W  11
      NOCN=NCOM(4)                                                        W  12
      NALPHA=NCOM(12)                                                     W  13
      NDOLL=IN(15)                                                        W  14
      IF (J.LE.0) GO TO 120                                               W  15
      IF (J.GT.NOCN) GO TO 120                                            W  16
      NDSC=NTIME                                                          W  17
      IF (NTRACT(2,J).NE.0) NDSC=NTRACT(2,J)                              W  18
      NCONST=IABS((100*(NTIME-NTRACT(3,J))/(NTRACT(3,J)-NDSC)+5)/10)      W  19
      IF (NCONST.LE.3) GO TO 130                                          W  20
      IF (NCONST.GT.7) GO TO 140                                          W  21
      NCI=(7*NDOLL)/10                                                    W  22
      IF ((NALPHA/100).LT.70) NCI=(5*NDOLL)/10                            W  23
      IF ((NALPHA/100).LT.50) NCI=(3*NDOLL)/10                            W  24
  110 IN(15)=NCI                                                          W  25
  120 RETURN                                                              W  26
  130 NCI=0                                                               W  27
      GO TO 110                                                           W  28
  140 NCI=NDOLL                                                           W  29
      GO TO 110                                                           W  30
      END                                                                 W  31-
      SUBROUTINE ACTNJ                                                    X   1
C     ROUTINE TO CHANGE AUTHORIZED FUNDING                                X   2
C     REVISED 1/74 TO IGNORE SIGN ERRORS                                  X   3
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  X   4
     1                                                                    X   5
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  X   6
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                X   7
      INTEGER*2 J,K,ISAVE                                                 X   8
      DIMENSION ACTN(16,120)                                              X   9
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        X  10
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  X  11
     120),NAC(5,120)                                                      X  12
      COMMON MONS(12)                                                     X  13
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  X  14
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     X  15
      EQUIVALENCE (J,NCOM(4))                                             X  16
      K=IN(4)                                                             X  17
      IF (K.LT.1) GO TO 110                                               X  18
      IF (K.GT.J) GO TO 110                                               X  19
C      CANNOT RETURN MORE THAN UNEXPENDED FUNDS                           X  20
      ISAVE=NTRACT(4,K)-(10*NTRACT(10,K))/7                               X  21
      IF ((IN(15).LT.0).AND.(ISAVE+IN(15).LT.0)) IN(15)=-ISAVE            X  22
      NTRACT(4,K)=NTRACT(4,K)+IN(15)                                      X  23
      NCOM(19)=NCOM(19)-IN(15)                                            X  24
  110 RETURN                                                              X  25
      END                                                                 X  26-
      SUBROUTINE ACTNN                                                    Y   1
C      RETURN UNUSED FUNDS TO PROJECT BIN                                 Y   2
C     (ONLY RECORD IS INVOICED AMOUNT (70%)IN NTRACT(10)    )             Y   3
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  Y   4
     1                                                                    Y   5
      DIMENSION ACTN(16,120)                                              Y   6
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        Y   7
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  Y   8
     120),NAC(5,120)                                                      Y   9
      COMMON MONS(12)                                                     Y  10
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  Y  11
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     Y  12
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  Y  13
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                Y  14
      INTEGER*2 K,IHIT,I,JA,KAT,KATE                                      Y  15
      EQUIVALENCE (K,NCOM(1))                                             Y  16
      EQUIVALENCE (KAT,NCOM(4))                                           Y  17
      IHIT=0                                                              Y  18
C       FIRST DEACTIVATE ALL ACTIVITIES FOR THIS CONTRACT                 Y  19
      DO 110 I=1,K                                                        Y  20
      IF (NACTIV(4,I).NE.IN(4)) GO TO 110                                 Y  21
      CALL PACK (0,15,I)                                                  Y  22
      IHIT=1                                                              Y  23
  110 CONTINUE                                                            Y  24
C       NOW FIND FINAL COSTS AND RETURN REST TO PROJECT BUDGET BIN        Y  25
C     FINAL COST IS 140% OF COST TO DATE                                  Y  26
      DO 120 I=1,KAT                                                      Y  27
      IF (IN(4).EQ.NTRACT(1,I)) GO TO 130                                 Y  28
  120 CONTINUE                                                            Y  29
      RETURN                                                              Y  30
  130 KATE=(143*NTRACT(10,I))/100                                         Y  31
      NCOM(19)=NCOM(19)+NTRACT(4,I)-KATE                                  Y  32
      NTRACT(11,I)=KATE                                                   Y  33
      RETURN                                                              Y  34
      END                                                                 Y  35-
      SUBROUTINE ACTNS                                                    Z   1
C     ROUTINE TO INCREASE (OR DECREASE) TOTAL VALUE OF WORK TO BE DONE    Z   2
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14))  Z   3
     1                                                                    Z   4
      DIMENSION ACTN(16,120)                                              Z   5
      COMMON /LOCAL/ ISCHDM,ISTRDM                                        Z   6
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1  Z   7
     120),NAC(5,120)                                                      Z   8
      COMMON MONS(12)                                                     Z   9
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15,  Z  10
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                     Z  11
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K  Z  12
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                                Z  13
      INTEGER*2 I,NBIT,NO,NCOST,NP,K,NTR,IN4                              Z  14
      REAL IN15                                                           Z  15
      DIMENSION RATE(5)                                                   Z  16
      DIMENSION COMP(5)                                                   Z  17
      IN4=IN(4)                                                           Z  18
      OVHD=NTRACT(5,IN4)                                                  Z  19
      IF (NTRACT(5,IN4).EQ.0) OVHD=100.                                   Z  20
      IN15=(IN(15)*100.0)/OVHD                                            Z  21
      NP=NCOM(3)                                                          Z  22
      DO 150 I=1,NP                                                       Z  23
      IF (NCOMP(1,I).NE.IN(4)) GO TO 150                                  Z  24
      COMP(1)=NCOMP(11,I)                                                 Z  25
      COMP(2)=NCOMP(12,I)                                                 Z  26
      COMP(3)=NCOMP(13,I)                                                 Z  27
      COMP(4)=NCOMP(14,I)                                                 Z  28
      COMP(5)=NCOMP(15,I)                                                 Z  29
      IF (NCOMP(2,I).NE.0) GO TO 110                                      Z  30
      K=I                                                                 Z  31
      RATE(5)=(IN15+COMP(1))/COMP(1)                                      Z  32
  110 IF (IN(5).EQ.0.AND.IN(6).EQ.0) GO TO 140                            Z  33
      IF (NCOMP(2,I).EQ.IN(5).OR.NCOMP(2,I).EQ.0) GO TO 120               Z  34
      GO TO 150                                                           Z  35
  120 IF (NCOMP(3,I).EQ.IN(6)) GO TO 130                                  Z  36
      IF (NCOMP(3,I).EQ.0.AND.NCOMP(2,I).EQ.0) GO TO 140                  Z  37
      IF (NCOMP(3,I).EQ.0) GO TO 130                                      Z  38
      IF (IN(6).EQ.0) GO TO 140                                           Z  39
      GO TO 150                                                           Z  40
  130 CONTINUE                                                            Z  41
  140 RATE(1)=COMP(2)/COMP(1)                                             Z  42
      RATE(2)=COMP(3)/COMP(1)                                             Z  43
      RATE(3)=COMP(4)/COMP(1)                                             Z  44
      RATE(4)=COMP(5)/COMP(1)                                             Z  45
      COMP(1)=COMP(1)*RATE(5)+.5                                          Z  46
      NCOMP(12,I)=COMP(1)*RATE(1)+.5                                      Z  47
      NCOMP(13,I)=COMP(1)*RATE(2)+.5                                      Z  48
      NCOMP(14,I)=COMP(1)*RATE(3)+.5                                      Z  49
      NCOMP(15,I)=COMP(1)*RATE(4)+.5                                      Z  50
      NCOMP(11,I)=COMP(1)                                                 Z  51
  150 CONTINUE                                                            Z  52
      NTR=IN(4)                                                           Z  53
      NTRACT(9,NTR)=NCOMP(11,K)                                           Z  54
      RETURN                                                              Z  55
      END                                                                 Z  56-
      SUBROUTINE ACTNT                                                   AA   1
C     ACTNT TURNS THE EXISTENCE INDICATORS OF ALL ACTIVITIES IN THE      AA   2
C     SPECIFIED CONTRACT EITHER OFF OR ON DEPENDING ON WHETHER THE       AA   3
C     ACTION IS TO FREEZE OR UNFREEZE THE COMPONENT RESPECTIVELY.        AA   4
      EQUIVALENCE (K,NCOM(1))                                            AA   5
      EQUIVALENCE (ACTN(1,1),NACTN(1,1)), (N,NCOM(1)), (NOMEGA,NCOM(14)) AA   6
     1                                                                   AA   7
      DIMENSION ACTN(16,120)                                             AA   8
      COMMON /LOCAL/ ISCHDM,ISTRDM                                       AA   9
      COMMON /LOCAL/ NACTN(16,120),IPERB(21,99),NDIST(99),IN(22),NAA(3,1 AA  10
     120),NAC(5,120)                                                     AA  11
      COMMON MONS(12)                                                    AA  12
      COMMON NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15),NREP(15, AA  13
     15),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS,KA,KC                    AA  14
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS,K AA  15
     1A,KC,IPERB,NDIST,IN,NAA,NAC,N,NOMEGA                               AA  16
      INTEGER*2 I,K,NI                                                   AA  17
      DO 110 I=1,K                                                       AA  18
      IF (NACTIV(4,I).NE.IN(4)) GO TO 110                                AA  19
      IF (NACTIV(5,I).NE.IN(5)) GO TO 110                                AA  20
      IF (NACTIV(6,I).NE.IN(6)) GO TO 110                                AA  21
      CALL UNPAK (NI,15,I)                                               AA  22
      IF (NI.LT.0) GO TO 120                                             AA  23
      CALL UNPAK (NI,3,I)                                                AA  24
      L=NI                                                               AA  25
      CALL PACK (L,15,I)                                                 AA  26
      CALL PACK (0,3,I)                                                  AA  27
  110 CONTINUE                                                           AA  28
      RETURN                                                             AA  29
  120 CALL PACK (0,15,I)                                                 AA  30
      CALL PACK (1,3,I)                                                  AA  31
      GO TO 110                                                          AA  32
      END                                                                AA  33-
      SUBROUTINE REPGEN                                                  AB   1
C     * REPGEN STORAGE AREAS**                                           AB   2
      COMMON MONS(12),NCOM(22),NACTIV(66,999),ICOMP(48,50),NTRCT(13,15), AB   3
     1NREP(15,5),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS                  AB   4
      INTEGER*2 NCOM,NACTIV,ICOMP,NTRCT,NREP,NCPDAT,NDATE,NDAYS,NPLRS    AB   5
      INTEGER YES                                                        AB   6
      COMMON /CNSTNT/ KMON,LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME          AB   7
      INTEGER*2 LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME                     AB   8
      COMMON /MISC/ IFLAG,IQ,LINE,NUMSYS,NUMCMP                          AB   9
      INTEGER*2 IFLAG,IQ,LINE,NUMSYS,NUMCMP                              AB  10
      COMMON /OUTPUT/ OUT(20),IOUT(1050)                                 AB  11
      INTEGER*2 IOUT                                                     AB  12
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST,BLNK                    AB  13
      EQUIVALENCE (NCOM(10),NORG), (NCOM(13),BETA), (NCOM(4),MAXCNT), (N AB  14
     1COM(3),MAXCMP), (NCOM(6),MANNO), (NCOM(1),MAXACT)                  AB  15
      INTEGER*2 NORG,BETA,MAXCNT,MAXCMP,MANNO,MAXACT                     AB  16
      INTEGER*2 I,J,BLNK                                                 AB  17
C     ******************************                                     AB  18
      JFLAG=0                                                            AB  19
      MONO=NCOM(21)                                                      AB  20
C     *************************                                          AB  21
C     * COMPUTE REPORT DATE ***                                          AB  22
C     *************************                                          AB  23
      KDAY=NDATE(MONO)                                                   AB  24
      KMON=MONS(MONO)                                                    AB  25
      KYR=NCOM(20)                                                       AB  26
      CALL CDATE (KDAY,KMON,KYR,NTIME)                                   AB  27
C     ************************                                           AB  28
C     * COMPUTE BASE MAXTE****                                           AB  29
C     ************************                                           AB  30
      BMAXTE=0                                                           AB  31
      DO 110 I=1,MAXCMP                                                  AB  32
      IF (ICOMP(19,I).GT.BMAXTE) BMAXTE=ICOMP(19,I)                      AB  33
  110 CONTINUE                                                           AB  34
      IF (NTRCT(3,1).NE.0) BMAXTE=NTRCT(3,1)                             AB  35
      IQ=0                                                               AB  36
      MOX=MONO                                                           AB  37
      IF (MOD(MOX,3).EQ.0) IQ=1                                          AB  38
      LEVEL=1                                                            AB  39
      CALL GENRPT                                                        AB  40
      DO 210 J=1,5                                                       AB  41
      DO 200 I=1,MAXCNT                                                  AB  42
      METZ=0                                                             AB  43
      IF (NTRCT(13,I).NE.0) GO TO 130                                    AB  44
      IF (NREP(I,J).GT.3) GO TO 120                                      AB  45
      GO TO 200                                                          AB  46
  120 METZ=NREP(I,J)                                                     AB  47
      NREP(I,J)=3                                                        AB  48
  130 M=I                                                                AB  49
      NIX=NREP(I,J)                                                      AB  50
      LEVEL=IABS(NIX)                                                    AB  51
      IF (LEVEL.EQ.0) GO TO 200                                          AB  52
      IF (NREP(I,J).GT.0) GO TO 140                                      AB  53
      IF (IQ.EQ.0) GO TO 200                                             AB  54
  140 CALL FETCHN (M,N,MAXCMP)                                           AB  55
      GO TO (150,160,170,180,190), J                                     AB  56
  150 IF (METZ.NE.0) NREP(I,J)=METZ                                      AB  57
      CALL RPT533                                                        AB  58
      IF (METZ.NE.0) NREP(I,J)=3                                         AB  59
      METZ=0                                                             AB  60
      GO TO 200                                                          AB  61
  160 CALL MGTSUM                                                        AB  62
      GO TO 200                                                          AB  63
  170 CALL MGTPLN                                                        AB  64
      GO TO 200                                                          AB  65
  180 IF (JFLAG.NE.0) GO TO 200                                          AB  66
      CALL NPERT                                                         AB  67
C      PRINT ONE TIME ONLY PER PLAYER                                    AB  68
      JFLAG=1                                                            AB  69
      GO TO 200                                                          AB  70
  190 CALL TCHNAR                                                        AB  71
  200 CONTINUE                                                           AB  72
  210 CONTINUE                                                           AB  73
C      PRINT RELIABILITY CONTRACTOR'S REPORTS                            AB  74
C     ASSUMES CONTRACT NO 12 IS "RELIABILITY"                            AB  75
      IF (NREP(12,5).EQ.0) GO TO 230                                     AB  76
      WRITE (6,240)                                                      AB  77
      LEVEL=2                                                            AB  78
      CALL HEDGEN (2)                                                    AB  79
      WRITE (6,250)                                                      AB  80
      DO 220 J=1,49                                                      AB  81
C      SUPPRESS PRINT OF LEVEL 1 OR INACTIVE ITEMS                       AB  82
      IF (ICOMP(2,J).EQ.0) GO TO 220                                     AB  83
      IF (ICOMP(36,J).EQ.0) GO TO 220                                    AB  84
      TEMP=ICOMP(36,J)                                                   AB  85
      TEMP=TEMP/100.0                                                    AB  86
      IF (TEMP.GE.1.0) TEMP=0.99                                         AB  87
      WRITE (6,260) ICOMP(1,J),ICOMP(2,J),ICOMP(3,J),ICOMP(4,J),ICOMP(5, AB  88
     1J),ICOMP(6,J),ICOMP(7,J),ICOMP(8,J),ICOMP(9,J),TEMP                AB  89
  220 CONTINUE                                                           AB  90
  230 CONTINUE                                                           AB  91
      WRITE (11) NCPDAT                                                  AB  92
C      INSERT TWO BLANK PAGES FOR XEROX LEADER                           AB  93
      WRITE (6,270)                                                      AB  94
      RETURN                                                             AB  95
C                                                                        AB  96
  240 FORMAT (1H1,55X,19HTECHNICAL NARRATIVE,5X,25H*** COMPONENT SUMMARY AB  97
     1 ***//)                                                            AB  98
  250 FORMAT (46X,9HCOMPONENT,39X,30H***** EXPECTED TECHNICAL *****/44X, AB  99
     114HIDENTIFICATION,17X,11HDESCRIPTION,18X,11HPERFORMANCE/)          AB 100
  260 FORMAT (1X,I49,2I2,21X,6A2,15X,F10.2)                              AB 101
  270 FORMAT (1H1,/1H1)                                                  AB 102
      END                                                                AB 103-
      SUBROUTINE MSHFT (M,B1,B2,B3)                                      AC   1
      DIMENSION B1(4), B2(4), B3(4), TBL(12)                             AC   2
      DATA TBL/'J','F','M','A','M','J','J','A','S','O','N','D'/          AC   3
      INTEGER*2 B1,B2,B3,M,TBL,J,L,I                                     AC   4
      NONO=M                                                             AC   5
      M=M-1                                                              AC   6
      IF (M.EQ.0) M=12                                                   AC   7
      J=M+4                                                              AC   8
      IF (J.GT.12) J=J-12                                                AC   9
      L=M+8                                                              AC  10
      IF (L.GT.12) L=L-12                                                AC  11
      DO 110 I=1,4                                                       AC  12
      M=M+1                                                              AC  13
      IF (M.GT.12) M=1                                                   AC  14
      B1(I)=TBL(M)                                                       AC  15
      J=J+1                                                              AC  16
      IF (J.GT.12) J=1                                                   AC  17
      B2(I)=TBL(J)                                                       AC  18
      L=L+1                                                              AC  19
      IF (L.GT.12) L=1                                                   AC  20
      B3(I)=TBL(L)                                                       AC  21
  110 CONTINUE                                                           AC  22
      M=NONO                                                             AC  23
      RETURN                                                             AC  24
      END                                                                AC  25-
      SUBROUTINE FETCHN (M,N,MAXCMP)                                     AD   1
      COMMON MONS(12),NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15) AD   2
      INTEGER*2 MAXCMP,M,N,I                                             AD   3
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT                                 AD   4
      DO 110 I=1,MAXCMP                                                  AD   5
      IF (NTRACT(1,M).NE.NCOMP(1,I)) GO TO 110                           AD   6
      IF (NCOMP(3,I).NE.0.OR.NCOMP(2,I).NE.0) GO TO 110                  AD   7
      N=I                                                                AD   8
      GO TO 120                                                          AD   9
  110 CONTINUE                                                           AD  10
  120 RETURN                                                             AD  11
      END                                                                AD  12-
      SUBROUTINE GENRPT                                                  AE   1
C                                                                        AE   2
C      REFEREE'S MISC. REPORTS AND PLAYER'S SUMMARY REPORT               AE   3
C                                                                        AE   4
      COMMON MONS(12),NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15) AE   5
     1,NREP(15,5),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS                 AE   6
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS   AE   7
      INTEGER YES                                                        AE   8
      COMMON /CNSTNT/ KMON,LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME          AE   9
      INTEGER*2 LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME                     AE  10
      INTEGER*2 MAXTE,IHTI,ICNT                                          AE  11
      COMMON /OUTPUT/ OUT(20),IOUT(1050)                                 AE  12
      INTEGER*2 IOUT                                                     AE  13
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST                         AE  14
      EQUIVALENCE (NCOM(8),KAY), (NCOM(1),NOACT), (NCOM(3),MAXCMP), (NCO AE  15
     1M(4),MAXCNT), (NCOM(2),NOPERT)                                     AE  16
      INTEGER*2 KAY,NOACT,MAXCMP,MAXCNT,NOPERT                           AE  17
      DIMENSION ISAVE(999)                                               AE  18
      INTEGER*2 I,J,K,L,IPM,NYR,ISAVE                                    AE  19
C      REPORT OF PERTURBATIONS NOW IN EFFECT                             AE  20
      WRITE (6,400)                                                      AE  21
      WRITE (6,410)                                                      AE  22
      IHTI=0                                                             AE  23
      DO 110 L=1,NOACT                                                   AE  24
  110 ISAVE(L)=0                                                         AE  25
      DO 140 I=1,NOACT                                                   AE  26
      CALL UNPAK (K,15,I)                                                AE  27
      IF (K.GE.0) GO TO 140                                              AE  28
      IPM=NACTIV(7,I)                                                    AE  29
      ISAVE(I)=IPM                                                       AE  30
      IF (IPM.EQ.0) GO TO 140                                            AE  31
      IX=I-1                                                             AE  32
      IF (IX.EQ.0) GO TO 130                                             AE  33
      DO 120 J=1,IX                                                      AE  34
      IF (IPM.EQ.ISAVE(J)) GO TO 140                                     AE  35
  120 CONTINUE                                                           AE  36
  130 WRITE (6,420) IPM                                                  AE  37
      IHTI=1                                                             AE  38
  140 CONTINUE                                                           AE  39
      IF (IHTI.EQ.0) WRITE (6,430)                                       AE  40
C     TCP REPORT PROGRAM BEGINS HERE                                     AE  41
      MAXTE=0                                                            AE  42
      ICNT=0                                                             AE  43
      IOUT(5)=0                                                          AE  44
      IOUT(2)=0                                                          AE  45
      NCPDAT(2,KAY)=0                                                    AE  46
      NCPDAT(3,KAY)=0                                                    AE  47
      NCPDAT(4,KAY)=0                                                    AE  48
      NCPDAT(5,KAY)=0                                                    AE  49
      DO 150 I=1,MAXCNT                                                  AE  50
      CALL FETCHN (I,J,MAXCMP)                                           AE  51
      NCPDAT(2,KAY)=NCPDAT(2,KAY)+((NCOMP(29,J)+NCOMP(43,J))*NTRACT(5,I) AE  52
     1)/100                                                              AE  53
      IOUT(5)=IOUT(5)+(NCOMP(11,J)*NTRACT(5,I))/100                      AE  54
      IOUT(2)=IOUT(2)+(NCOMP(43,J)*NTRACT(5,I))/100                      AE  55
      IF (NTRACT(13,I).EQ.0) GO TO 150                                   AE  56
      ICNT=ICNT+1                                                        AE  57
      NCPDAT(3,KAY)=NCPDAT(3,KAY)+NCOMP(34,J)                            AE  58
      NCPDAT(4,KAY)=NCPDAT(4,KAY)+NCOMP(35,J)                            AE  59
      NCPDAT(5,KAY)=NCPDAT(5,KAY)+NCOMP(36,J)                            AE  60
  150 CONTINUE                                                           AE  61
      NCPDAT(3,KAY)=NCPDAT(3,KAY)/ICNT                                   AE  62
      NCPDAT(4,KAY)=NCPDAT(4,KAY)/ICNT                                   AE  63
      NCPDAT(5,KAY)=NCPDAT(5,KAY)/ICNT                                   AE  64
      NCPDAT(1,KAY)=NCOM(15)                                             AE  65
C     TCP - COMPONENT SUMMARY REPORT BEGINS HERE.  ADDED BY WOLF 7-70.   AE  66
      WRITE (6,280)                                                      AE  67
      LEVEL=3                                                            AE  68
      CALL HEDGEN (1)                                                    AE  69
      WRITE (6,290)                                                      AE  70
      DO 160 J=1,MAXCMP                                                  AE  71
      TEMP=NCOMP(36,J)                                                   AE  72
      TEMP1=NCOMP(34,J)                                                  AE  73
      TEMP2=NCOMP(35,J)                                                  AE  74
      TEMP=TEMP/100.0                                                    AE  75
      TEMP1=TEMP1/100.0                                                  AE  76
      TEMP2=TEMP2/100.0                                                  AE  77
      IF (TEMP.GE.1.0) TEMP=0.99                                         AE  78
      IF (TEMP1.GE.1.0) TEMP1=0.99                                       AE  79
      IF (TEMP2.GE.1.0) TEMP2=0.99                                       AE  80
      WRITE (6,300) NCOMP(1,J),NCOMP(2,J),NCOMP(3,J),NCOMP(4,J),NCOMP(5, AE  81
     1J),NCOMP(6,J),NCOMP(7,J),NCOMP(8,J),NCOMP(9,J),TEMP,TEMP1,TEMP2    AE  82
  160 CONTINUE                                                           AE  83
C      INSERT TWO BLANK PAGES                                            AE  84
      WRITE (6,310)                                                      AE  85
C     PROJECT LEVEL MANAGEMENT SUMMARY REPORT BEGINS HERE                AE  86
      LEVEL=0                                                            AE  87
      CALL HEDGEN (1)                                                    AE  88
      WRITE (6,440)                                                      AE  89
      WRITE (6,500)                                                      AE  90
      DO 170 I=1,KAY                                                     AE  91
      CALL CLNDR (NCPDAT(1,I),IOUT(7),OUT(1),IOUT(8))                    AE  92
      WRITE (6,390) I,IOUT(7),OUT(1),IOUT(8),(NCPDAT(J,I),J=2,5)         AE  93
  170 CONTINUE                                                           AE  94
      IOUT5=IOUT(5)                                                      AE  95
      IOUT2=IOUT(2)                                                      AE  96
      IOUT(1)=IOUT5*IOUT2/NCPDAT(2,KAY)                                  AE  97
      IOUT(3)=IOUT(1)-IOUT(2)                                            AE  98
      IOUT(6)=IOUT(5)-NCPDAT(2,KAY)                                      AE  99
      IOUT(4)=NCPDAT(2,KAY)                                              AE 100
      ITEMP3=IOUT(3)                                                     AE 101
      ITEMP6=IOUT(6)                                                     AE 102
      WRITE (6,450)                                                      AE 103
      IF (IOUT(3).LT.0.AND.IOUT(6).LT.0) GO TO 180                       AE 104
      IF (IOUT(3).LT.0) GO TO 190                                        AE 105
      IF (IOUT(6).LT.0) GO TO 200                                        AE 106
      WRITE (6,460) (IOUT(K),K=1,6)                                      AE 107
      GO TO 210                                                          AE 108
  180 IOUT(3)=IABS(ITEMP3)                                               AE 109
      IOUT(6)=IABS(ITEMP6)                                               AE 110
      WRITE (6,470) (IOUT(K),K=1,6)                                      AE 111
      GO TO 210                                                          AE 112
  190 IOUT(3)=IABS(ITEMP3)                                               AE 113
      WRITE (6,480) (IOUT(K),K=1,6)                                      AE 114
      GO TO 210                                                          AE 115
  200 IOUT(6)=IABS(ITEMP6)                                               AE 116
      WRITE (6,490) (IOUT(K),K=1,6)                                      AE 117
  210 NSUM=0                                                             AE 118
      WRITE (6,330)                                                      AE 119
      DO 260 I=1,MAXCNT                                                  AE 120
      CALL FETCHN (I,J,MAXCMP)                                           AE 121
      IF (NTRACT(13,I).GT.0) GO TO 230                                   AE 122
      IF (NTRACT(11,I).NE.0) GO TO 220                                   AE 123
      WRITE (6,320) NTRACT(1,I),(NCOMP(II,J),II=4,9)                     AE 124
      GO TO 260                                                          AE 125
  220 MSUM=NTRACT(11,I)                                                  AE 126
      WRITE (6,340) NTRACT(1,I),(NCOMP(II,J),II=4,9),MSUM,MSUM,MSUM      AE 127
      GO TO 250                                                          AE 128
  230 MSUM=NTRACT(4,I)                                                   AE 129
      IOUT(1)=NTRACT(5,I)*NTRACT(9,I)/100                                AE 130
      IOUT(2)=((NTRACT(8,I)+NTRACT(9,I))*NTRACT(5,I))/100                AE 131
      IF (NCOMP(37,J).EQ.0) NCOMP(37,J)=NCOMP(28,J)                      AE 132
      CALL CLNDR (NCOMP(37,J),IOUT(3),OUT(1),IOUT(4))                    AE 133
      IF (NTRACT(3,I).EQ.0) GO TO 240                                    AE 134
      CALL CLNDR (NTRACT(3,I),IOUT(5),OUT(2),IOUT(6))                    AE 135
      WRITE (6,350) NTRACT(1,I),(NCOMP(II,J),II=4,9),IOUT(1),MSUM,NTRACT AE 136
     1(11,I),IOUT(2),IOUT(3),OUT(1),IOUT(4),IOUT(5),OUT(2),IOUT(6)       AE 137
      GO TO 250                                                          AE 138
  240 WRITE (6,350) NTRACT(1,I),(NCOMP(II,J),II=4,9),IOUT(1),MSUM,NTRACT AE 139
     1(11,I),IOUT(2),IOUT(3),OUT(1),IOUT(4)                              AE 140
  250 NSUM=NSUM+MSUM                                                     AE 141
  260 CONTINUE                                                           AE 142
      MSUM=NSUM+NCOM(19)                                                 AE 143
      WRITE (6,360) MSUM                                                 AE 144
      WRITE (6,370) NCOM(19)                                             AE 145
      IF (NCOM(19).GE.0) GO TO 270                                       AE 146
      WRITE (6,380)                                                      AE 147
  270 RETURN                                                             AE 148
C                                                                        AE 149
  280 FORMAT (1H1,47X,30HTCP - COMPONENT SUMMARY REPORT//)               AE 150
  290 FORMAT (46X,9HCOMPONENT,39X,30H********** EXPECTED **********/95X, AE 151
     1'TECHNICAL'/44X,14HIDENTIFICATION,17X,11HDESCRIPTION,8X,30HPERFORM AE 152
     2ANCE     TIME      COST/)                                          AE 153
  300 FORMAT (1X,I49,2I2,21X,6A2,7X,3F10.2)                              AE 154
  310 FORMAT (1H1,/,1H1)                                                 AE 155
  320 FORMAT (I4,2X,6A2,4X,' NOT AWARDED',/)                             AE 156
  330 FORMAT (///,30X,'FUNDED   PAYMENTS',5X,'FINAL',3X,'END',8X,'SCHED' AE 157
     1,/,9X,'CONTRACT   VALUE',4X,'TO DATE  TO DATE    ESTIMATE   DATE'9 AE 158
     2X,'DATE',//)                                                       AE 159
  340 FORMAT (I4,2X,6A2,I6,'K  ',I6,'K  ',I8,'K',8X,'TERMINATED',/)      AE 160
  350 FORMAT (I4,2X,6A2,I6,'K  ',I6,'K  ',I8,'K',I8,'K',2(2X,I3,A4,I3)/) AE 161
  360 FORMAT (//20X,'FINANCIAL AUTHORITY RCVD. TO DATE'I6,'K')           AE 162
  370 FORMAT (/,20X,'UNOBLIGATED FUNDS'16X,I6,'K')                       AE 163
  380 FORMAT (///,5X,'**** PROJECT OBLIGATION AUTHORITY EXCEEDED ****')  AE 164
  390 FORMAT (40X,I5,I6,A4,I3,I8,5X,1H.,I2,4H   .,I2,6X,1H.,I2)          AE 165
  400 FORMAT (1H1,55X,19HPERTURBATION REPORT//)                          AE 166
  410 FORMAT ('0',35X,'PROJECT CONDITIONS HAVE ACTIVATED THE FOLLOWING P AE 167
     1ERTURBATIONS'//)                                                   AE 168
  420 FORMAT (I62)                                                       AE 169
  430 FORMAT (58X,4HNONE)                                                AE 170
  440 FORMAT (47X,35H  PROJECT MANAGEMENT SUMMARY REPORT//)              AE 171
  450 FORMAT (1H0,22X,22HWORK PERFORMED TO DATE,26X,20HTOTALS AT COMPLET AE 172
     1ION,9X///29X16HACTUAL (OVERRUN)20X,24H EST. FINAL  CONTRACT   9H(O AE 173
     2VERRUN),9X/11X,4HITEM,7X,26HVALUE   COST   UNDERRUN   20X,15H COST AE 174
     3     VALUE,7X,8HUNDERRUN//)                                        AE 175
  460 FORMAT (7X,13HTOTAL PROJECT,2I7,3X,I7,20X,I9,I10,7X,I7)            AE 176
  470 FORMAT (7X,13HTOTAL PROJECT,2I7,3X,2H (,I4,1H),20X,I9,I10,7X,2H (, AE 177
     1I4,1H))                                                            AE 178
  480 FORMAT (7X,13HTOTAL PROJECT,2I7,3X,2H (,I4,1H),20X,I9,I10,I12)     AE 179
  490 FORMAT (7X,13HTOTAL PROJECT,2I7,3X,I7,20X,I9,I10,7X,2H (,I4,1H))   AE 180
  500 FORMAT (39X,6H PLAY ,1X,2(3X,8HEXPECTED),7X,13HPROBABILITIES/40X,4 AE 181
     12HNUMBER   END DATE   END COST  TIME  COST  ,11HPERFORMANCE//)     AE 182
      END                                                                AE 183-
      SUBROUTINE RPT533                                                  AF   1
C     533 REPORT                                                         AF   2
C     RPT533 STORAGE AREAS *                                             AF   3
      COMMON MONS(12),NCOM(22),NACTIV(66,999),ICOMP(48,50),NTRACT(13,15) AF   4
     1,NREP(15,5),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS                 AF   5
      INTEGER*2 NCOM,NACTIV,ICOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS,NPLRS   AF   6
      COMMON /MISC/ IFLAG,IQ,LINE,NUMSYS,NUMCMP                          AF   7
      INTEGER YES                                                        AF   8
      INTEGER*2 IFLAG,IQ,LINE,NUMSYS,NUMCMP                              AF   9
      COMMON /OUTPUT/ OUT(20),IOUT(1050)                                 AF  10
      INTEGER*2 IOUT                                                     AF  11
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST                         AF  12
      COMMON /CNSTNT/ KMON,LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME          AF  13
      INTEGER*2 LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME                     AF  14
      EQUIVALENCE (NCOM(1),MAXACT), (NCOM(3),MAXCMP)                     AF  15
      INTEGER*2 MAXACT,MAXCMP,JJ,I,J                                     AF  16
      DIMENSION IT(5)                                                    AF  17
      DATA IT/'CPFF','CPAF','CPIF','FFP','COST'/                         AF  18
C     **************************************                             AF  19
C     N = INDEX FOR COMPONENT, THIS REPORT *                             AF  20
C     M = ASSOCIATED CONTRACT INDEX        *                             AF  21
C     **************************************                             AF  22
      WRITE (6,220)                                                      AF  23
      CALL HEDGEN (1)                                                    AF  24
      LINE=22                                                            AF  25
      J=NTRACT(13,M)                                                     AF  26
      K=1                                                                AF  27
      IF (NTRACT(13,M).EQ.0) GO TO 190                                   AF  28
      NUMCMP=(ICOMP(11,N)*NTRACT(5,M))/100                               AF  29
      WRITE (6,230) (ICOMP(I,N),I=4,9),IT(J),NUMCMP,NTRACT(4,M),NTRACT(1 AF  30
     10,M),NTRACT(11,M),KDAY,KMON,KYR                                    AF  31
C      ADD OUT OF FUNDS WARNING IF CONTRACT FROZEN OR WILL BE            AF  32
      IF ((11*NTRACT(10,M)/7).GT.NTRACT(4,M)) WRITE (6,300)              AF  33
      WRITE (6,240)                                                      AF  34
      NUMCMP=ICOMP(1,N)                                                  AF  35
C     ****************************                                       AF  36
C     CONTRACT DATA - ALL LEVELS *                                       AF  37
C     ****************************                                       AF  38
      CALL COUT1 (N,3)                                                   AF  39
C     ********************************                                   AF  40
C     BEGIN SEARCH FOR MEMBER SYSTEM *                                   AF  41
C     ********************************                                   AF  42
      DO 180 I=1,MAXCMP                                                  AF  43
      IF (ICOMP(1,I).NE.NUMCMP) GO TO 170                                AF  44
C     **************************                                         AF  45
C     SYSTEM DATA - ALL LEVELS *                                         AF  46
C     **************************                                         AF  47
      IF (ICOMP(2,I).NE.0.OR.ICOMP(3,I).NE.0) GO TO 110                  AF  48
      IF (LEVEL.NE.1) GO TO 110                                          AF  49
      CALL CBOUT1 (I,3)                                                  AF  50
      RETURN                                                             AF  51
  110 IF (ICOMP(2,I).EQ.0) GO TO 170                                     AF  52
      IF (ICOMP(3,I).NE.0) GO TO 170                                     AF  53
      NUMSYS=ICOMP(2,I)                                                  AF  54
      CALL COUT1 (I,2)                                                   AF  55
      LINE=LINE+2                                                        AF  56
C     *********************************                                  AF  57
C     LEVEL 2 - SYSTEM BREAKDOWN DATA *                                  AF  58
C     *********************************                                  AF  59
      CALL CBOUT1 (I,2)                                                  AF  60
      LINE=LINE+8                                                        AF  61
      IF (LEVEL.GT.2) GO TO 120                                          AF  62
      GO TO 170                                                          AF  63
C     ************************************                               AF  64
C     BEGIN SEARCH FOR MEMBER SUB-SYSTEM *                               AF  65
C     ************************************                               AF  66
  120 DO 160 J=1,MAXCMP                                                  AF  67
      IF (ICOMP(1,J).NE.NUMCMP) GO TO 160                                AF  68
      IF (ICOMP(2,J).NE.NUMSYS) GO TO 160                                AF  69
      DO 140 JJ=J,MAXCMP                                                 AF  70
      IF (LINE.LT.50) GO TO 130                                          AF  71
      WRITE (6,220)                                                      AF  72
      K=K+1                                                              AF  73
      CALL HEDGEN (K)                                                    AF  74
      WRITE (6,240)                                                      AF  75
      LINE=6                                                             AF  76
  130 IF (ICOMP(1,JJ).NE.NUMCMP) GO TO 140                               AF  77
      IF (ICOMP(2,JJ).NE.NUMSYS) GO TO 140                               AF  78
      IF (ICOMP(3,JJ).NE.0) GO TO 150                                    AF  79
      IF (ICOMP(3,JJ).EQ.0.AND.ICOMP(1,JJ).GT.1) GO TO 180               AF  80
  140 CONTINUE                                                           AF  81
      CALL CBOUT1 (I,2)                                                  AF  82
      LINE=LINE+8                                                        AF  83
      GO TO 160                                                          AF  84
  150 IF (JJ.GT.J) GO TO 160                                             AF  85
C     **********************************                                 AF  86
C     SUB-SYSTEM DATA - LEVELS 3 AND 4 *                                 AF  87
C     **********************************                                 AF  88
      CALL COUT1 (JJ,1)                                                  AF  89
      LINE=LINE+4                                                        AF  90
C     *************************************                              AF  91
C     LEVEL 3 - SUB-SYSTEM BREAKDOWN DATA *                              AF  92
C     *************************************                              AF  93
      CALL CBOUT1 (JJ,1)                                                 AF  94
      LINE=LINE+8                                                        AF  95
  160 CONTINUE                                                           AF  96
  170 CONTINUE                                                           AF  97
  180 CONTINUE                                                           AF  98
      RETURN                                                             AF  99
  190 WRITE (6,260) (ICOMP(I,N),I=4,9),NTRACT(4,M)                       AF 100
      WRITE (6,270) NTRACT(11,M)                                         AF 101
      METZ=NTRACT(4,M)-NTRACT(11,M)                                      AF 102
      IF (METZ.LT.0) GO TO 200                                           AF 103
      WRITE (6,280) METZ                                                 AF 104
      GO TO 210                                                          AF 105
  200 METZ=-METZ                                                         AF 106
      WRITE (6,290) METZ                                                 AF 107
  210 WRITE (6,250)                                                      AF 108
      RETURN                                                             AF 109
C                                                                        AF 110
  220 FORMAT (1H1,43X,43HNASA CONTRACTOR FINANCIAL MANAGEMENT REPORT//)  AF 111
  230 FORMAT (49X,33H(FIGURES IN THOUSANDS OF DOLLARS)//84X,26HINVOICE   AF 112
     1 TOTAL     REPORT/33X,11HDESCRIPTION,12X,4HTYPE,8X,25HVALUE  CEILI AF 113
     2NG  AMOUNTS  16HPAYMENTS    DATE//40X,6A2,5X,A4,I12,I8,2I9,I6,1X,A AF 114
     33,I3//)                                                            AF 115
  240 FORMAT (93X,4HBAL./33X,12HCURRENT QTR ,35X,4HBAL.,9X,2HOF,5X,6HTOT AF 116
     1AL ,21H EST.   CON-     EST./17X,3HPD.,5X,4HTO (,2X,3HMO.,2(4X,3HM AF 117
     2O.),4(4X,3HQTR),4X,2HOF,5X,10HNEXT  CON-,5X,3HTO ,2H) ,12HFINAL  T AF 118
     3RACT4X,5HCOMPL/5X,4HITEM,7X,12HCOSTS   DATE,1H(,2X,3H(1),4X,3H(2), AF 119
     44X,3H(3),4X,3H(2),4X,3H(3),4X,3H(4),4X,3H(5),1X,2(3X,4HF.Y.),2X,5H AF 120
     5TRACT,2X,27HCOMPL) COST   VALUE    DATE/28X,1H(,76X,1H))           AF 121
  250 FORMAT (45X,84H**** NOTICE **** FINAL REPORT FOR THIS CONTRACT-CAN AF 122
     1CELLED THIS PLAY **** NOTICE ****)                                 AF 123
  260 FORMAT (5X,6A2,5X,'ORIGINAL FUNDED AMOUNT =',I6,'K',//)            AF 124
  270 FORMAT (10X,'FINAL COST INCLUDING CLOSING COSTS =',I6,'K',//)      AF 125
  280 FORMAT (19X,'FUNDS RETURNED TO PROJECT ='I6,'K',///)               AF 126
  290 FORMAT (22X,'ADDITIONAL AMOUNT FUNDED ='I6,'K',///)                AF 127
  300 FORMAT (22X'**FUNDING LIMITATION EXCEEDED **')                     AF 128
      END                                                                AF 129-
      SUBROUTINE COUT1 (N,L)                                             AG   1
C     COUT1 STORAGE AREAS *                                              AG   2
      COMMON MONS(12),NCOM(22),NACTIV(66,999),ICOMP(48,50),NTRACT(13,15) AG   3
     1,NREP(15,5)                                                        AG   4
      INTEGER*2 NCOM,NACTIV,ICOMP,NTRACT,NREP                            AG   5
      COMMON /CNSTNT/ KMON,LEVEL,DUM,M,MONO,KDAY,KYR,BMAXTE,NTIME        AG   6
      INTEGER*2 LEVEL,DUM,M,MONO,KDAY,KYR,BMAXTE,NTIME                   AG   7
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST,BLNK                    AG   8
      COMMON /MISC/ IFLAG,IQ,LINE,NUMSYS,NUMCMP                          AG   9
      INTEGER YES                                                        AG  10
      INTEGER*2 IFLAG,IQ,LINE,NUMSYS,NUMCMP                              AG  11
      COMMON /OUTPUT/ OUT(20),IOUT(550)                                  AG  12
      INTEGER*2 IOUT                                                     AG  13
      EQUIVALENCE (NCOM(1),MAXACT)                                       AG  14
      INTEGER*2 MAXACT,BLNK                                              AG  15
      INTEGER*2 I,MOD1,J,N,ICOST,ITIME,JTIME,IBACK,I2,MOD2               AG  16
      IFLAG=0                                                            AG  17
      DO 110 I=1,15                                                      AG  18
  110 IOUT(I)=0                                                          AG  19
      MOD1=MONO-1                                                        AG  20
      IHOLD=MOD1                                                         AG  21
      MOD1=MOD(IHOLD,3)+1                                                AG  22
C     ******************************                                     AG  23
C     SEARCH FOR MEMBER ACTIVITIES *                                     AG  24
C     ******************************                                     AG  25
      DO 230 I=1,MAXACT                                                  AG  26
      DO 120 IZZ=1,15                                                    AG  27
      IF (IZZ.NE.NACTIV(4,I)) GO TO 120                                  AG  28
      CALL UNPAK (J,15,I)                                                AG  29
      IF (J.GE.0.AND.NREP(IZZ,1).EQ.4) GO TO 130                         AG  30
  120 CONTINUE                                                           AG  31
      CALL UNPAK (J,15,I)                                                AG  32
      IF (J.GE.0) GO TO 230                                              AG  33
  130 CONTINUE                                                           AG  34
      GO TO (140,150,160), L                                             AG  35
  140 IF (NACTIV(6,I).NE.ICOMP(3,N)) GO TO 230                           AG  36
  150 IF (NACTIV(5,I).NE.ICOMP(2,N)) GO TO 230                           AG  37
  160 IF (NACTIV(4,I).NE.ICOMP(1,N)) GO TO 230                           AG  38
C     *******************                                                AG  39
C     UNPACK TOTAL COST *                                                AG  40
C     *******************                                                AG  41
      ICOST=NACTIV(46,I)                                                 AG  42
      ITIME=NCOM(17)                                                     AG  43
      JTIME=-NCOM(17)                                                    AG  44
      CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AG  45
      IOUT(1)=IOUT(1)+IBACK                                              AG  46
C     ***************************************                            AG  47
C     ACCUMULATE MONTHLY PROPORTIONAL COSTS *                            AG  48
C     ***************************************                            AG  49
      ITIME=1                                                            AG  50
      JTIME=0                                                            AG  51
      GO TO (180,190,170), MOD1                                          AG  52
  170 CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AG  53
      IOUT(3)=IOUT(3)+IBACK                                              AG  54
      JTIME=JTIME+1                                                      AG  55
  180 CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AG  56
      IOUT(4)=IOUT(4)+IBACK                                              AG  57
      JTIME=JTIME+1                                                      AG  58
  190 CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AG  59
      IOUT(5)=IOUT(5)+IBACK                                              AG  60
C     *****************************************                          AG  61
C     ACCUMULATE QUARTERLY PROPORTIONAL COSTS *                          AG  62
C     *****************************************                          AG  63
      ITIME=3                                                            AG  64
      JTIME=JTIME+1                                                      AG  65
      DO 200 I2=6,9                                                      AG  66
      CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AG  67
      JTIME=JTIME+3                                                      AG  68
  200 IOUT(I2)=IOUT(I2)+IBACK                                            AG  69
C     *************************************                              AG  70
C     ACCUMULATE MISC. PROPORTIONAL COSTS *                              AG  71
C     *************************************                              AG  72
      MOD2=JTIME+MONO                                                    AG  73
      IF (MOD2.EQ.15.OR.MOD2.EQ.27) GO TO 210                            AG  74
      IF (MOD2.EQ.18) GO TO 220                                          AG  75
      ITIME=ITIME+3                                                      AG  76
      IF (MOD2.EQ.24) GO TO 210                                          AG  77
      ITIME=ITIME+3                                                      AG  78
  210 CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AG  79
      IOUT(10)=IOUT(10)+IBACK                                            AG  80
      JTIME=JTIME+ITIME                                                  AG  81
  220 ITIME=12                                                           AG  82
      CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AG  83
      IOUT(11)=IOUT(11)+IBACK                                            AG  84
      JTIME=JTIME+12                                                     AG  85
      CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AG  86
      IOUT(12)=IOUT(12)+IBACK                                            AG  87
      IFLAG=1                                                            AG  88
  230 CONTINUE                                                           AG  89
      IF (IFLAG.EQ.1) GO TO 250                                          AG  90
      DO 240 I=16,17                                                     AG  91
  240 IOUT(I)=BLNK                                                       AG  92
      OUT(17)=BLANK                                                      AG  93
      GO TO 290                                                          AG  94
  250 IF (ICOMP(37,N).NE.0) GO TO 260                                    AG  95
      CALL CLNDR (ICOMP(28,N),IOUT(16),OUT(17),IOUT(17))                 AG  96
      GO TO 270                                                          AG  97
  260 CALL CLNDR (ICOMP(37,N),IOUT(16),OUT(17),IOUT(17))                 AG  98
  270 CALL BTOD (IOUT(16))                                               AG  99
      CALL BTOD (IOUT(17))                                               AG 100
      IOUT(2)=ICOMP(43,N)                                                AG 101
      DO 280 I=1,15                                                      AG 102
  280 IOUT(I)=(IOUT(I)*NTRACT(5,M)+50)/100                               AG 103
      IOUT(13)=IOUT(3)+IOUT(4)+IOUT(5)+IOUT(6)+IOUT(7)+IOUT(8)+IOUT(9)+I AG 104
     1OUT(10)+IOUT(11)+IOUT(12)                                          AG 105
      IOUT(14)=IOUT(13)+IOUT(2)                                          AG 106
      IOUT(15)=ICOMP(11,N)*NTRACT(5,M)/100                               AG 107
  290 WRITE (6,300) (ICOMP(I,N),I=4,9),(IOUT(I),I=1,16),OUT(17),IOUT(17) AG 108
      RETURN                                                             AG 109
C                                                                        AG 110
  300 FORMAT (28X,1H(,76X,1H)/2X,6A2,2I7,1H(,I6,10I7,1H),I6,I7,2X,A4,A4, AG 111
     1A3)                                                                AG 112
      END                                                                AG 113-
      BLOCK DATA                                                         AH   1
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST,BLNK                    AH   2
      INTEGER YES                                                        AH   3
      INTEGER*2 BLNK                                                     AH   4
      DATA HEAD(1,1),HEAD(2,1),HEAD(3,1),HEAD(4,1),HEAD(5,1),HEAD(6,1),H AH   5
     1EAD(1,2),HEAD(2,2),HEAD(3,2),HEAD(4,2),HEAD(5,2),HEAD(6,2),HEAD(1, AH   6
     23),HEAD(2,3),HEAD(3,3),HEAD(4,3),HEAD(5,3),HEAD(6,3),HEAD(1,4),HEA AH   7
     3D(2,4),HEAD(3,4),HEAD(4,4),HEAD(5,4),HEAD(6,4),YES,NO,BLANK,AST,BL AH   8
     4NK/3*' ','  EN','GR L','ABOR',3*' ','   M','ATER','IALS',3*' ','   AH   9
     5TE','CH L','ABOR',3*' ',' SUB','CONT','RACT',' YES','  NO',' ','*' AH  10
     6,' '/                                                              AH  11
      END                                                                AH  12-
      SUBROUTINE CBOUT1 (N,L)                                            AI   1
C     CBOUT1 STORAGE AREAS *                                             AI   2
      COMMON MONS(12),NCOM(22),NACTIV(66,999),ICOMP(48,50),NTRACT(13,15) AI   3
     1,NREP(15,5)                                                        AI   4
      INTEGER*2 NCOM,NACTIV,ICOMP,NTRACT,NREP                            AI   5
      COMMON /MISC/ IFLAG,IQ,LINE,NUMSYS,NUMCMP                          AI   6
      INTEGER*2 IFLAG,IQ,LINE,NUMSYS,NUMCMP                              AI   7
      COMMON /OUTPUT/ OUT(20),IOUT(4,15)                                 AI   8
      INTEGER*2 IOUT                                                     AI   9
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST                         AI  10
      COMMON /CNSTNT/ KMON,LEVEL,DUM,M,MONO,KDAY,KYR,BMAXTE,NTIME        AI  11
      INTEGER*2 LEVEL,DUM,M,MONO,KDAY,KYR,BMAXTE,NTIME                   AI  12
      EQUIVALENCE (NCOM(1),MAXACT)                                       AI  13
      INTEGER*2 MAXACT                                                   AI  14
      INTEGER YES                                                        AI  15
      INTEGER*2 I,J,MOD1,N,ICOST,ITIME,JTIME,IBACK,K,MOD2                AI  16
      DO 110 I=1,15                                                      AI  17
      DO 110 J=1,4                                                       AI  18
  110 IOUT(J,I)=0                                                        AI  19
      MOD1=MONO-1                                                        AI  20
      MTEMP=MOD1                                                         AI  21
      MOD1=MOD(MTEMP,3)+1                                                AI  22
C     ******************************                                     AI  23
C     SEARCH FOR MEMBER ACTIVITIES *                                     AI  24
C     ******************************                                     AI  25
      DO 290 I=1,MAXACT                                                  AI  26
      DO 120 IZZ=1,15                                                    AI  27
      IF (IZZ.NE.NACTIV(4,I)) GO TO 120                                  AI  28
      CALL UNPAK (J,15,I)                                                AI  29
      IF (J.GE.0.AND.NREP(IZZ,1).EQ.4) GO TO 130                         AI  30
  120 CONTINUE                                                           AI  31
      CALL UNPAK (J,15,I)                                                AI  32
      IF (J.GE.0) GO TO 290                                              AI  33
  130 CONTINUE                                                           AI  34
      GO TO (140,150,160), L                                             AI  35
  140 IF (NACTIV(6,I).NE.ICOMP(3,N)) GO TO 290                           AI  36
  150 IF (NACTIV(5,I).NE.ICOMP(2,N)) GO TO 290                           AI  37
  160 IF (NACTIV(4,I).NE.ICOMP(1,N)) GO TO 290                           AI  38
      DO 280 J=1,4                                                       AI  39
      GO TO (170,180,190,200), J                                         AI  40
C     *************************                                          AI  41
C     UNPACK ENGINEERING COST *                                          AI  42
C     *************************                                          AI  43
  170 ICOST=NACTIV(47,I)                                                 AI  44
      GO TO 210                                                          AI  45
C     **********************                                             AI  46
C     UNPACK MATERIAL COST *                                             AI  47
C     **********************                                             AI  48
  180 ICOST=NACTIV(48,I)                                                 AI  49
      GO TO 210                                                          AI  50
C     ***********************                                            AI  51
C     UNPACK TECHNICAL COST *                                            AI  52
C     ***********************                                            AI  53
  190 ICOST=NACTIV(49,I)                                                 AI  54
      GO TO 210                                                          AI  55
C     ****************************                                       AI  56
C     UNPACK SUBCONTRACTING COST *                                       AI  57
C     ****************************                                       AI  58
  200 ICOST=NACTIV(50,I)                                                 AI  59
C     ***************************************                            AI  60
C     ACCUMULATE MONTHLY PROPORTIONAL COSTS *                            AI  61
C     ***************************************                            AI  62
  210 ITIME=NCOM(17)                                                     AI  63
      JTIME=-NCOM(17)                                                    AI  64
      CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AI  65
      IOUT(J,1)=IOUT(J,1)+IBACK                                          AI  66
      ITIME=1                                                            AI  67
      JTIME=0                                                            AI  68
      GO TO (230,240,220), MOD1                                          AI  69
  220 CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AI  70
      IOUT(J,3)=IOUT(J,3)+IBACK                                          AI  71
      JTIME=JTIME+1                                                      AI  72
  230 CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AI  73
      IOUT(J,4)=IOUT(J,4)+IBACK                                          AI  74
      JTIME=JTIME+1                                                      AI  75
  240 CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AI  76
      IOUT(J,5)=IOUT(J,5)+IBACK                                          AI  77
      ITIME=3                                                            AI  78
      JTIME=JTIME+1                                                      AI  79
C     *****************************************                          AI  80
C     ACCUMULATE QUARTERLY PROPORTIONAL COSTS *                          AI  81
C     *****************************************                          AI  82
      DO 250 K=6,9                                                       AI  83
      CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AI  84
      JTIME=JTIME+3                                                      AI  85
  250 IOUT(J,K)=IOUT(J,K)+IBACK                                          AI  86
C     *************************************                              AI  87
C     ACCUMULATE MISC. PROPORTIONAL COSTS *                              AI  88
C     *************************************                              AI  89
      MOD2=JTIME+MONO                                                    AI  90
      IF (MOD2.EQ.15.OR.MOD2.EQ.27) GO TO 260                            AI  91
      IF (MOD2.EQ.18) GO TO 270                                          AI  92
      ITIME=ITIME+3                                                      AI  93
      IF (MOD2.EQ.24) GO TO 260                                          AI  94
      ITIME=ITIME+3                                                      AI  95
  260 CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AI  96
      IOUT(J,10)=IOUT(J,10)+IBACK                                        AI  97
      JTIME=JTIME+ITIME                                                  AI  98
  270 ITIME=12                                                           AI  99
      CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AI 100
      IOUT(J,11)=IOUT(J,11)+IBACK                                        AI 101
      JTIME=JTIME+12                                                     AI 102
      CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AI 103
      IOUT(J,12)=IOUT(J,12)+IBACK                                        AI 104
      IOUT(J,2)=ICOMP(J+43,N)                                            AI 105
      IOUT(J,15)=ICOMP(J+11,N)                                           AI 106
  280 CONTINUE                                                           AI 107
  290 CONTINUE                                                           AI 108
      DO 310 J=1,4                                                       AI 109
      DO 300 K=1,15                                                      AI 110
  300 IOUT(J,K)=(IOUT(J,K)*NTRACT(5,M)+50)/100                           AI 111
      IOUT(J,13)=IOUT(J,3)+IOUT(J,4)+IOUT(J,5)+IOUT(J,6)+IOUT(J,7)+IOUT( AI 112
     1J,8)+IOUT(J,9)+IOUT(J,10)+IOUT(J,11)+IOUT(J,12)                    AI 113
      IOUT(J,14)=IOUT(J,13)+IOUT(J,2)                                    AI 114
      WRITE (6,320) (HEAD(K,J),K=1,6),(IOUT(J,K),K=1,15)                 AI 115
  310 CONTINUE                                                           AI 116
      WRITE (6,330)                                                      AI 117
      RETURN                                                             AI 118
C                                                                        AI 119
  320 FORMAT (2X,3A4,14X,1H(,76X,1H)/2X,3A4,2I7,1H(,I6,10I7,1H),I6,I7)   AI 120
  330 FORMAT (28X,1H(,76X,1H))                                           AI 121
      END                                                                AI 122-
      SUBROUTINE CALCF (I,ITIME,JTIME,ICOST,IBACK)                       AJ   1
C     CALCF STORAGE AREAS *                                              AJ   2
      COMMON MONS(12),NCOM(22),NACTIV(66,999),ICOMP(48,50),NTRACT(13,15) AJ   3
     1,NREP(15,5),NCPDAT(5,30),NDATE(12),NDAYS(12)                       AJ   4
      INTEGER*2 NCOM,NACTIV,ICOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS         AJ   5
      COMMON /CNSTNT/ KMON,LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME          AJ   6
      INTEGER*2 LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME                     AJ   7
      INTEGER*2 JTE,ITE,K,JTIME,NYR,NSTRT,ITIME,NSTOP,KSTRT,IF,IBACK,ICO AJ   8
     1ST,I                                                               AJ   9
C     ******************************************                         AJ  10
C     CALCF COMPUTES THE PROPORTION OF AN      *                         AJ  11
C     ACTIVITY FALLING WITHIN THE TIME FRAME   *                         AJ  12
C     BEGINNING AT 'JTIME' AND HAVING DURATION *                         AJ  13
C     'ITIME'.  THIS PROPORTION, 'F' , IS THEN *                         AJ  14
C     USED TO COMPUTE THE PROPORTIONAL COST    *                         AJ  15
C     WHICH IS RETURNED TO THE CALLING PROGRAM *                         AJ  16
C     IN 'IBACK'.                              *                         AJ  17
C     ******************************************                         AJ  18
      JTE=NACTIV(41,I)                                                   AJ  19
      ITE=NACTIV(42,I)                                                   AJ  20
      K=NCOM(21)+JTIME                                                   AJ  21
      NYR=NCOM(20)                                                       AJ  22
  110 IF (K.LE.12) GO TO 120                                             AJ  23
      K=K-12                                                             AJ  24
      NYR=NYR+1                                                          AJ  25
      GO TO 110                                                          AJ  26
  120 IF (K.GE.1) GO TO 130                                              AJ  27
      K=K+12                                                             AJ  28
      NYR=NYR-1                                                          AJ  29
      GO TO 120                                                          AJ  30
  130 CALL CDATE (NDATE(K),MONS(K),NYR,NSTRT)                            AJ  31
      K=K+ITIME                                                          AJ  32
  140 IF (K.LE.12) GO TO 150                                             AJ  33
      K=K-12                                                             AJ  34
      NYR=NYR+1                                                          AJ  35
      GO TO 140                                                          AJ  36
  150 CALL CDATE (NDATE(K),MONS(K),NYR,NSTOP)                            AJ  37
      KSTRT=ITE-JTE                                                      AJ  38
      IF (KSTRT.LT.NSTOP.AND.ITE.GT.NSTRT) GO TO 160                     AJ  39
      IF=0                                                               AJ  40
      GO TO 200                                                          AJ  41
  160 IF (KSTRT.LT.NSTRT.OR.ITE.GT.NSTOP) GO TO 170                      AJ  42
      IF=1000                                                            AJ  43
      GO TO 200                                                          AJ  44
  170 IF (KSTRT.LT.NSTRT) GO TO 180                                      AJ  45
      IF=((NSTOP-KSTRT)*1000)/JTE                                        AJ  46
      GO TO 200                                                          AJ  47
  180 IF (KSTRT.GT.NSTRT.OR.ITE.LE.NSTOP) GO TO 190                      AJ  48
      IF=((NSTOP-NSTRT)*1000)/JTE                                        AJ  49
      GO TO 200                                                          AJ  50
  190 IF=((ITE-NSTRT)*1000)/JTE                                          AJ  51
  200 IBACK=((IF*ICOST)+499)/1000                                        AJ  52
      RETURN                                                             AJ  53
      END                                                                AJ  54-
      SUBROUTINE MGTSUM                                                  AK   1
C     MANAGEMENT SUMMARY REPORT                                          AK   2
C     MGTSUM STORAGE AREA *                                              AK   3
      DIMENSION HOL1(4), HOL2(4), HOL3(4)                                AK   4
      INTEGER*2 MAXACT,MAXCMP,HOL1,HOL2,HOL3,NYR,K,I,J,JJ                AK   5
      COMMON MONS(12),NCOM(22),NACTIV(66,999),ICOMP(48,50),NTRACT(13,15) AK   6
     1,NREP(15,5),NCPDAT(5,30),NDATE(12),NDAYS(12)                       AK   7
      INTEGER*2 NCOM,NACTIV,ICOMP,NTRACT,NREP,NCPDAT,NDATE,NDAYS         AK   8
      COMMON /CNSTNT/ KMON,LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME          AK   9
      INTEGER*2 LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME                     AK  10
      EQUIVALENCE (NCOM(3),MAXCMP), (NCOM(1),MAXACT)                     AK  11
      COMMON /MISC/ IFLAG,IQ,LINE,NUMSYS,NUMCMP                          AK  12
      INTEGER*2 IFLAG,IQ,LINE,NUMSYS,NUMCMP                              AK  13
C     **************************************                             AK  14
C     N = INDEX FOR COMPONENT, THIS REPORT *                             AK  15
C     **************************************                             AK  16
      WRITE (6,180)                                                      AK  17
      CALL HEDGEN (1)                                                    AK  18
      NUMCMP=ICOMP(1,N)                                                  AK  19
      NYR=NCOM(20)                                                       AK  20
      K=NCOM(21)-1                                                       AK  21
      IF (K.GT.0) GO TO 110                                              AK  22
      K=12                                                               AK  23
      NYR=NYR-1                                                          AK  24
  110 CALL MSHFT (MONO,HOL1,HOL2,HOL3)                                   AK  25
      WRITE (6,190) (ICOMP(I,N),I=4,9),NDATE(K),MONS(K),NYR,KDAY,KMON,KY AK  26
     1R                                                                  AK  27
      WRITE (6,200) HOL1,HOL2,HOL3,HOL1,HOL2,HOL3,HOL1,(HOL2(I),I=1,2)   AK  28
      LINE=18                                                            AK  29
C     ****************************                                       AK  30
C     CONTRACT DATA - ALL LEVELS *                                       AK  31
C     ****************************                                       AK  32
      CALL COUT2 (N,3)                                                   AK  33
C     ********************************                                   AK  34
C     BEGIN SEARCH FOR MEMBER SYSTEM *                                   AK  35
C     ********************************                                   AK  36
      DO 170 I=1,MAXCMP                                                  AK  37
      IF (ICOMP(1,I).NE.NUMCMP) GO TO 170                                AK  38
C     **************************                                         AK  39
C     SYSTEM DATA - ALL LEVELS *                                         AK  40
C     **************************                                         AK  41
      IF (ICOMP(2,I).NE.0.OR.ICOMP(3,I).NE.0) GO TO 120                  AK  42
      IF (LEVEL.NE.1) GO TO 120                                          AK  43
      CALL CBOUT2 (I,3)                                                  AK  44
      RETURN                                                             AK  45
  120 IF (ICOMP(2,I).EQ.0) GO TO 170                                     AK  46
      IF (ICOMP(3,I).NE.0) GO TO 170                                     AK  47
      NUMSYS=ICOMP(2,I)                                                  AK  48
      CALL COUT2 (I,2)                                                   AK  49
C     *********************************                                  AK  50
C     LEVEL 2 - SYSTEM BREAKDOWN DATA *                                  AK  51
C     *********************************                                  AK  52
      CALL CBOUT2 (I,2)                                                  AK  53
      IF (LEVEL.GT.2) GO TO 130                                          AK  54
      GO TO 170                                                          AK  55
C     ************************************                               AK  56
C     BEGIN SEARCH FOR MEMBER SUB-SYSTEM *                               AK  57
C     ************************************                               AK  58
  130 DO 160 J=1,MAXCMP                                                  AK  59
      IF (ICOMP(1,J).NE.NUMCMP) GO TO 160                                AK  60
      IF (ICOMP(2,J).NE.NUMSYS) GO TO 160                                AK  61
      DO 140 JJ=J,MAXCMP                                                 AK  62
      IF (ICOMP(1,JJ).NE.NUMCMP) GO TO 140                               AK  63
      IF (ICOMP(2,JJ).NE.NUMSYS) GO TO 140                               AK  64
      IF (ICOMP(3,JJ).NE.0) GO TO 150                                    AK  65
      IF (ICOMP(3,JJ).EQ.0.AND.ICOMP(1,JJ).GT.1) GO TO 170               AK  66
  140 CONTINUE                                                           AK  67
      CALL CBOUT2 (I,2)                                                  AK  68
      GO TO 170                                                          AK  69
  150 IF (JJ.GT.J) GO TO 160                                             AK  70
C     **********************************                                 AK  71
C     SUB-SYSTEM DATA - LEVELS 3 AND 4 *                                 AK  72
C     **********************************                                 AK  73
      CALL COUT2 (JJ,1)                                                  AK  74
C     *************************************                              AK  75
C     LEVEL 3 - SUB-SYSTEM BREAKDOWN DATA *                              AK  76
C     *************************************                              AK  77
      CALL CBOUT2 (JJ,1)                                                 AK  78
  160 CONTINUE                                                           AK  79
  170 CONTINUE                                                           AK  80
      WRITE (6,210)                                                      AK  81
      RETURN                                                             AK  82
C                                                                        AK  83
  180 FORMAT (1H1,47X,35HNASA PERT MANAGEMENT SUMMARY REPORT//)          AK  84
  190 FORMAT (28X,8HCONTRACT,23X,10HCONTRACTOR,16X,12HREPORT DATES/39X,6 AK  85
     1A2,9X,7HVARIOUS,I14,A4,I3,4H  TO,I4,A4,I3//)                       AK  86
  200 FORMAT (23X,48HWORK PERFORMED TO DATE      TOTALS AT COMPLETION,9X AK  87
     123HE - EARLIEST COMPL DATE/80X,10HS - SCHED 10HCOMPL DATE/57X,34HL AK  88
     2ATEST   PROJECTED     L - LATEST 10HCOMPL DATE/29X,37HACTUAL  (OVE AK  89
     3RRUN)  PLANNED  REVISED  9H(OVERRUN),9X,16H(SEE NOTE BELOW),15X,3H AK  90
     4DAY,7X,5HSLACK/11X,4HITEM,7X,40HVALUE   COST   UNDERRUN    COST    AK  91
     5   EST,4X,8HUNDERRUN,3X,30A1,4X,1HE,4X,1HL,4X,1HS,9H  (WEEKS)//)   AK  92
  210 FORMAT (/////52H0NOTE - - EXPLANATION OF SYMBOLS OTHER THAN E, L,  AK  93
     1S./20X31H8              E AND L TOGETHER/20X31HG              E AN AK  94
     2D S TOGETHER/20X31HN              L AND S TOGETHER/20X31HRECORD MA AK  95
     3RK    E, L, S TOGETHER)                                            AK  96
      END                                                                AK  97-
      SUBROUTINE COUT2 (N,L)                                             AL   1
C      REVISED 10/75 TO REMOVE CALL TO 'TSHFT'                           AL   2
C                                                                        AL   3
      INTEGER*2 IL,IE,IS,IG,IN,I8,IR                                     AL   4
      DATA IL,IE,IS,IG,IN,I8,IR/'L','E','S','G','N','8','R'/             AL   5
C     COUT2 STORAGE AREAS *                                              AL   6
      EQUIVALENCE (NCOM(1),MAXACT)                                       AL   7
      INTEGER*2 MAXACT,I,N,MM,J,ITEM,JTEM,KTEM,ICOST,ITIME,JTIME,IBACK,K AL   8
     1,MX,MT                                                             AL   9
      COMMON MONS(12),NCOM(22),NACTIV(66,999),ICOMP(48,50),NTRCT(13,15), AL  10
     1NREP(15,5),NCPDAT(5,30),NDATE(12),NDAYS(12)                        AL  11
      INTEGER*2 NCOM,NACTIV,ICOMP,NTRCT,NREP,NCPDAT,NDATE,NDAYS          AL  12
      COMMON /CNSTNT/ KMON,LEVEL,DUM,MM,MONO,KDAY,KYR,BMAXTE,NTIME       AL  13
      INTEGER YES                                                        AL  14
      INTEGER*2 LEVEL,DUM,MM,MONO,KDAY,KYR,BMAXTE,NTIME                  AL  15
      COMMON /MISC/ IFLAG,IQ,LINE,NUMSYS,NUMCMP,M(3)                     AL  16
      INTEGER*2 IFLAG,IQ,M,LINE,NUMSYS,NUMCMP                            AL  17
      COMMON /OUTPUT/ OUT(20),IOUT(1050)                                 AL  18
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST,BLNK                    AL  19
      INTEGER*2 IOUT,BLNK                                                AL  20
      DO 110 I=1,3                                                       AL  21
      IOUT(I)=0                                                          AL  22
      IOUT(I+3)=0                                                        AL  23
      M(I)=0                                                             AL  24
  110 CONTINUE                                                           AL  25
      OUT(15)=BLANK                                                      AL  26
      DO 120 I=7,39                                                      AL  27
  120 IOUT(I)=BLNK                                                       AL  28
      IOUT(2)=ICOMP(43,N)*NTRCT(5,MM)/100                                AL  29
      IOUT(40)=32767                                                     AL  30
      IF (L.EQ.3) M(3)=NTRCT(3,MM)                                       AL  31
      IF (L.EQ.2) M(3)=ICOMP(10,N)                                       AL  32
C     ****************************                                       AL  33
C     SEARCH FOR MEMBER ACTIVITY *                                       AL  34
C     ****************************                                       AL  35
      DO 170 I=1,MAXACT                                                  AL  36
      CALL UNPAK (J,15,I)                                                AL  37
      IF (J.GE.0) GO TO 170                                              AL  38
      GO TO (130,140,150), L                                             AL  39
  130 IF (NACTIV(6,I).NE.ICOMP(3,N)) GO TO 170                           AL  40
  140 IF (NACTIV(5,I).NE.ICOMP(2,N)) GO TO 170                           AL  41
  150 IF (NACTIV(4,I).NE.ICOMP(1,N)) GO TO 170                           AL  42
      CALL UNPAK (J,10,I)                                                AL  43
      CALL UNPAK (K,5,I)                                                 AL  44
      IF ((J+K).EQ.-2) GO TO 160                                         AL  45
      M(1)=NACTIV(42,I)                                                  AL  46
      M(2)=NACTIV(43,I)                                                  AL  47
      IOUT(40)=NACTIV(44,I)                                              AL  48
      OUT(15)=IOUT(40)                                                   AL  49
  160 ICOST=NACTIV(46,I)                                                 AL  50
      JOUT=IOUT(40)                                                      AL  51
      OUT(15)=JOUT                                                       AL  52
      ITIME=30                                                           AL  53
      JTIME=0                                                            AL  54
      CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AL  55
      IOUT(5)=IOUT(5)+IBACK                                              AL  56
  170 CONTINUE                                                           AL  57
      IF (IOUT(5).EQ.0.AND.IOUT(2).EQ.0) GO TO 180                       AL  58
      IOUT(1)=IOUT1                                                      AL  59
      IOUT3=ICOMP(11,N)                                                  AL  60
      IOUT2=IOUT(2)                                                      AL  61
      IOUT5=IOUT(5)                                                      AL  62
      IOUT1=IOUT3*IOUT2/(IOUT5+IOUT2)                                    AL  63
      IOUT(1)=IOUT1                                                      AL  64
      GO TO 190                                                          AL  65
  180 IOUT(1)=0                                                          AL  66
  190 IOUT(5)=IOUT(5)*NTRCT(5,MM)/100                                    AL  67
      IOUT(5)=IOUT(5)+IOUT(2)                                            AL  68
      IF (IOUT(5).EQ.0) RETURN                                           AL  69
      IOUT(3)=IOUT(1)-IOUT(2)                                            AL  70
      IOUT(4)=ICOMP(11,N)*NTRCT(5,MM)/100                                AL  71
      IOUT(6)=IOUT(4)-IOUT(5)                                            AL  72
      DO 230 I=1,3                                                       AL  73
      IF (M(I).EQ.0) GO TO 230                                           AL  74
      CALL CLNDR (M(I),IOUT(I+36),OUT(I+11),IOUT(I+40))                  AL  75
      CALL BTOD (IOUT(I+36))                                             AL  76
      K=MONO                                                             AL  77
      MX=1                                                               AL  78
      MT=7*(M(I)-NTIME)/10-NDAYS(K)+NDATE(K)                             AL  79
      IF (MT.LE.0) GO TO 220                                             AL  80
  200 IF (MT.LT.365) GO TO 210                                           AL  81
      MT=MT-365                                                          AL  82
      MX=MX+12                                                           AL  83
      GO TO 200                                                          AL  84
  210 K=K+1                                                              AL  85
      IF (K.GT.12) K=1                                                   AL  86
      MT=MT-NDAYS(K)                                                     AL  87
      MX=MX+1                                                            AL  88
      IF (MT.LT.0) GO TO 220                                             AL  89
      GO TO 210                                                          AL  90
  220 M(I)=MX                                                            AL  91
  230 CONTINUE                                                           AL  92
C      REPLACR 'TSHFT'-PUT SYMBOLS IN IOUT7TO36                          AL  93
      IF (M(1).EQ.0) GO TO 240                                           AL  94
      JJ=M(1)+6                                                          AL  95
      IOUT(JJ)=IE                                                        AL  96
      IF (M(1).EQ.M(2)) GO TO 260                                        AL  97
      IF (M(1).EQ.M(3)) GO TO 270                                        AL  98
  240 IF (M(2).EQ.0) GO TO 250                                           AL  99
      JJ=M(2)+6                                                          AL 100
      IOUT(JJ)=IL                                                        AL 101
      IF (M(2).EQ.M(3)) GO TO 280                                        AL 102
  250 IF (M(3).EQ.0) GO TO 300                                           AL 103
      JJ=M(3)+6                                                          AL 104
      IOUT(JJ)=IS                                                        AL 105
      GO TO 300                                                          AL 106
  260 IOUT(JJ)=I8                                                        AL 107
      IF (M(2).EQ.M(3)) GO TO 290                                        AL 108
      GO TO 250                                                          AL 109
  270 IOUT(JJ)=IG                                                        AL 110
      IF (M(2).EQ.0) GO TO 300                                           AL 111
      JJ=M(2)+6                                                          AL 112
      IOUT(JJ)=IS                                                        AL 113
      GO TO 300                                                          AL 114
  280 IOUT(JJ)=IN                                                        AL 115
      GO TO 300                                                          AL 116
  290 IOUT(JJ)=IR                                                        AL 117
  300 OUT(15)=OUT(15)/10.0                                               AL 118
      IF (IOUT(3).LT.0.AND.IOUT(6).LT.0) GO TO 310                       AL 119
      IF (IOUT(3).LT.0) GO TO 320                                        AL 120
      IF (IOUT(6).LT.0) GO TO 330                                        AL 121
      WRITE (6,370) (ICOMP(I,N),I=4,9),(IOUT(I),I=1,39),OUT(15)          AL 122
      RETURN                                                             AL 123
  310 IF (IOUT(3).LT.0) IOUT(3)=-IOUT(3)                                 AL 124
      IF (IOUT(6).LT.0) IOUT(6)=-IOUT(6)                                 AL 125
      WRITE (6,340) (ICOMP(I,N),I=4,9),(IOUT(I),I=1,39),OUT(15)          AL 126
      RETURN                                                             AL 127
  320 IF (IOUT(3).LT.0) IOUT(3)=-IOUT(3)                                 AL 128
      WRITE (6,350) (ICOMP(I,N),I=4,9),(IOUT(I),I=1,39),OUT(15)          AL 129
      RETURN                                                             AL 130
  330 IF (IOUT(6).LT.0) IOUT(6)=-IOUT(6)                                 AL 131
      WRITE (6,360) (ICOMP(I,N),I=4,9),(IOUT(I),I=1,39),OUT(15)          AL 132
      RETURN                                                             AL 133
C                                                                        AL 134
  340 FORMAT (1H0,7X,6A2,2I7,3X,2H (,I4,1H),I10,I9,3X,2H (,I4,1H),4X,30A AL 135
     11,3(3X,A2),F8.1)                                                   AL 136
  350 FORMAT (1H0,7X,6A2,2I7,3X,2H (,I4,1H),I10,I9,I10,4X,30A1,3(3X,A2), AL 137
     1F8.1)                                                              AL 138
  360 FORMAT (1H0,7X,6A2,2I7,2I10,I9,3X,2H (,I4,1H),4X,30A1,3(3X,A2),F8. AL 139
     11)                                                                 AL 140
  370 FORMAT (1H0,7X,6A2,2I7,2I10,I9,I10,4X,30A1,3(3X,A2),F8.1)          AL 141
      END                                                                AL 142-
      SUBROUTINE CBOUT2 (N,L)                                            AM   1
C     CBOUT2 STORAGE AREAS *                                             AM   2
      INTEGER*2 MAXACT,I,J,N,ICOST,JTIME,ITIME,IBACK,MM                  AM   3
      COMMON MONS(12),NCOM(22),NACTIV(66,999),ICOMP(48,50),NTRCT(13,15), AM   4
     1NREP(15,5),NCPDAT(5,30),NDATE(12),NDAYS(12)                        AM   5
      INTEGER*2 NCOM,NACTIV,ICOMP,NTRCT,NREP,NCPDAT,NDATE,NDAYS          AM   6
      COMMON /CNSTNT/ KMON,LEVEL,DUM,M,MONO,KDAY,KYR,BMAXTE,NTIME        AM   7
      INTEGER*2 LEVEL,DUM,M,MONO,KDAY,KYR,BMAXTE,NTIME                   AM   8
      COMMON /MISC/ IFLAG,IQ,LINE,NUMSYS,NUMCMP                          AM   9
      INTEGER*2 IFLAG,IQ,LINE,NUMSYS,NUMCMP                              AM  10
      COMMON /OUTPUT/ OUT(20),IOUT(4,6)                                  AM  11
      INTEGER YES                                                        AM  12
      INTEGER*2 IOUT                                                     AM  13
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST                         AM  14
      DIMENSION TEMP1(4), TEMP2(4), TEMP4(4), TEMP5(4)                   AM  15
      EQUIVALENCE (NCOM(1),MAXACT)                                       AM  16
      DO 110 I=1,6                                                       AM  17
      DO 110 J=1,4                                                       AM  18
  110 IOUT(J,I)=0                                                        AM  19
C     ****************************                                       AM  20
C     SEARCH FOR MEMBER ACTIVITY *                                       AM  21
C     ****************************                                       AM  22
      DO 210 I=1,MAXACT                                                  AM  23
      CALL UNPAK (J,15,I)                                                AM  24
      IF (J.GE.0) GO TO 210                                              AM  25
      GO TO (120,130,140), L                                             AM  26
  120 IF (NACTIV(6,I).NE.ICOMP(3,N)) GO TO 210                           AM  27
  130 IF (NACTIV(5,I).NE.ICOMP(2,N)) GO TO 210                           AM  28
  140 IF (NACTIV(4,I).NE.ICOMP(1,N)) GO TO 210                           AM  29
      DO 200 J=1,4                                                       AM  30
      GO TO (150,160,170,180), J                                         AM  31
C     ******************************                                     AM  32
C     ACCUMULATE ENGINEERING COSTS *                                     AM  33
C     ******************************                                     AM  34
  150 IOUT(J,2)=ICOMP(44,N)*NTRCT(5,M)/100                               AM  35
      IOUT(J,4)=ICOMP(12,N)                                              AM  36
      ICOST=NACTIV(47,I)                                                 AM  37
      GO TO 190                                                          AM  38
C     ***************************                                        AM  39
C     ACCUMULATE MATERIAL COSTS *                                        AM  40
C     ***************************                                        AM  41
  160 IOUT(J,2)=ICOMP(45,N)*NTRCT(5,M)/100                               AM  42
      IOUT(J,4)=ICOMP(13,N)                                              AM  43
      ICOST=NACTIV(48,I)                                                 AM  44
      GO TO 190                                                          AM  45
C     ****************************                                       AM  46
C     ACCUMULATE TECHNICAL COSTS *                                       AM  47
C     ****************************                                       AM  48
  170 IOUT(J,2)=ICOMP(46,N)*NTRCT(5,M)/100                               AM  49
      IOUT(J,4)=ICOMP(14,N)                                              AM  50
      ICOST=NACTIV(49,I)                                                 AM  51
      GO TO 190                                                          AM  52
C     *********************************                                  AM  53
C     ACCUMULATE SUBCONTRACTING COSTS *                                  AM  54
C     *********************************                                  AM  55
  180 IOUT(J,2)=ICOMP(47,N)*NTRCT(5,M)/100                               AM  56
      IOUT(J,4)=ICOMP(15,N)                                              AM  57
      ICOST=NACTIV(50,I)                                                 AM  58
  190 JTIME=0                                                            AM  59
      ITIME=30                                                           AM  60
      CALL CALCF (I,ITIME,JTIME,ICOST,IBACK)                             AM  61
      IOUT(J,5)=IOUT(J,5)+IBACK                                          AM  62
  200 CONTINUE                                                           AM  63
  210 CONTINUE                                                           AM  64
      DO 240 J=1,4                                                       AM  65
      TEMP2(J)=IOUT(J,2)                                                 AM  66
      TEMP4(J)=IOUT(J,4)                                                 AM  67
      TEMP5(J)=IOUT(J,5)                                                 AM  68
      IF (IOUT(J,5).EQ.0.AND.IOUT(J,2).EQ.0) GO TO 220                   AM  69
      TEMP1(J)=TEMP4(J)*TEMP2(J)/(TEMP2(J)+TEMP5(J))                     AM  70
      GO TO 230                                                          AM  71
  220 TEMP1(J)=0.0                                                       AM  72
  230 OVHD=NTRCT(5,M)                                                    AM  73
      TEMP5(J)=TEMP5(J)*OVHD/100.0                                       AM  74
      IOUT(J,3)=TEMP1(J)-TEMP2(J)                                        AM  75
      IOUT(J,4)=TEMP4(J)*OVHD/100.0                                      AM  76
      IOUT(J,5)=TEMP5(J)+TEMP2(J)                                        AM  77
      IOUT(J,6)=IOUT(J,4)-IOUT(J,5)                                      AM  78
      IOUT(J,1)=TEMP1(J)                                                 AM  79
  240 CONTINUE                                                           AM  80
      DO 280 I=1,4                                                       AM  81
      ITEMP3=IOUT(I,3)                                                   AM  82
      ITEMP6=IOUT(I,6)                                                   AM  83
      IF (IOUT(I,3).LT.0.AND.IOUT(I,6).LT.0) GO TO 250                   AM  84
      IF (IOUT(I,3).LT.0) GO TO 260                                      AM  85
      IF (IOUT(I,6).LT.0) GO TO 270                                      AM  86
      WRITE (6,320) (HEAD(J,I),J=1,6),(IOUT(I,J),J=1,6)                  AM  87
      GO TO 280                                                          AM  88
  250 IOUT(I,3)=IABS(ITEMP3)                                             AM  89
      IOUT(I,6)=IABS(ITEMP6)                                             AM  90
      WRITE (6,290) (HEAD(J,I),J=1,6),(IOUT(I,J),J=1,6)                  AM  91
      GO TO 280                                                          AM  92
  260 IOUT(I,3)=IABS(ITEMP3)                                             AM  93
      WRITE (6,300) (HEAD(J,I),J=1,6),(IOUT(I,J),J=1,6)                  AM  94
      GO TO 280                                                          AM  95
  270 IOUT(I,6)=IABS(ITEMP6)                                             AM  96
      WRITE (6,310) (HEAD(J,I),J=1,6),(IOUT(I,J),J=1,6)                  AM  97
  280 CONTINUE                                                           AM  98
      WRITE (6,330)                                                      AM  99
      RETURN                                                             AM 100
C                                                                        AM 101
  290 FORMAT (8X,3A4/8X,3A4,2I7,3X,2H (,I4,1H),I10,I9,3X,2H (,I4,1H))    AM 102
  300 FORMAT (8X,3A4/8X,3A4,2I7,3X,2H (,I4,1H),I10,I9,I10)               AM 103
  310 FORMAT (8X,3A4/8X,3A4,2I7,2I10,I9,3X,2H (,I4,1H))                  AM 104
  320 FORMAT (8X,3A4/8X,3A4,2I7,2I10,I9,I10)                             AM 105
  330 FORMAT (1H0)                                                       AM 106
      END                                                                AM 107-
      SUBROUTINE MGTPLN                                                  AN   1
C     PROGRAM MANAGEMENT PLAN                                            AN   2
C     MGTPLN STORAGE AREAS *                                             AN   3
      INTEGER YES                                                        AN   4
      INTEGER*2 I,KK,ITEM,J,II                                           AN   5
      COMMON MONS(12),NCOM(22),NACTIV(66,999),ICOMP(48,50),NTRCT(13,15), AN   6
     1NREP(15,5),NCPDAT(5,30),NDATE(12),NDAYS(12),NPLRS                  AN   7
      INTEGER*2 NCOM,NACTIV,ICOMP,NTRCT,NREP,NCPDAT,NDATE,NDAYS,NPLRS    AN   8
      COMMON /CNSTNT/ KMON,LEVEL,N                                       AN   9
      INTEGER*2 LEVEL,N                                                  AN  10
      COMMON /OUTPUT/ OUT(20),IOUT(1050)                                 AN  11
      INTEGER*2 IOUT                                                     AN  12
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST,BLNK                    AN  13
      COMMON /MISC/ IFLAG,IQ,LINE,NUMSYS,NUMCMP,M(3)                     AN  14
      INTEGER*2 IFLAG,IQ,M,LINE,NUMSYS,NUMCMP                            AN  15
      EQUIVALENCE (NCOM(1),MAXACT)                                       AN  16
      INTEGER*2 MAXACT,BLNK                                              AN  17
      DIMENSION NSORT(999)                                               AN  18
C     **************************************                             AN  19
C     N = INDEX FOR COMPONENT, THIS REPORT *                             AN  20
C     **************************************                             AN  21
      WRITE (6,300)                                                      AN  22
      NPAGE=1                                                            AN  23
      CALL HEDGEN (NPAGE)                                                AN  24
      WRITE (6,310)                                                      AN  25
      LINE=10                                                            AN  26
      II=0                                                               AN  27
  110 II=II+1                                                            AN  28
      CALL UNPAK (KK,15,II)                                              AN  29
      IF (KK.GE.0) GO TO 110                                             AN  30
      DO 120 J=1,15                                                      AN  31
      IF (NREP(J,3).EQ.0.AND.NACTIV(4,II).EQ.J) GO TO 110                AN  32
  120 CONTINUE                                                           AN  33
      NSORT(1)=II                                                        AN  34
      DO 130 J=2,999                                                     AN  35
  130 NSORT(J)=0                                                         AN  36
      K=II+1                                                             AN  37
      MM=K-1                                                             AN  38
      DO 200 II=K,MAXACT                                                 AN  39
      CALL UNPAK (KK,15,II)                                              AN  40
      IF (KK.GE.0) GO TO 200                                             AN  41
      DO 140 JJ=1,15                                                     AN  42
      IF (NREP(JJ,3).EQ.0.AND.NACTIV(4,II).EQ.JJ) GO TO 200              AN  43
  140 CONTINUE                                                           AN  44
      MM=MM+1                                                            AN  45
      IOUT(1)=NACTIV(42,II)                                              AN  46
      DO 190 J=1,MAXACT                                                  AN  47
      L=NSORT(J)                                                         AN  48
      IF (L.EQ.II) GO TO 200                                             AN  49
      IF ((L.LE.0).OR.(L.GT.999)) GO TO 190                              AN  50
      IOUT(2)=NACTIV(42,L)                                               AN  51
      IF (IOUT(1)-IOUT(2)) 150,180,170                                   AN  52
  150 KK=MM                                                              AN  53
      MX=MM-1                                                            AN  54
      DO 160 JJ=J,MX                                                     AN  55
      NSORT(KK)=NSORT(KK-1)                                              AN  56
  160 KK=KK-1                                                            AN  57
      NSORT(J)=II                                                        AN  58
      GO TO 200                                                          AN  59
  170 L=MM                                                               AN  60
      NSORT(L)=II                                                        AN  61
      GO TO 190                                                          AN  62
  180 IF (NACTIV(1,II)-NACTIV(1,L)) 150,150,170                          AN  63
  190 CONTINUE                                                           AN  64
  200 CONTINUE                                                           AN  65
      DO 210 I=1,6                                                       AN  66
  210 IOUT(I+21)=ICOMP(I+3,N)                                            AN  67
C     **********************************                                 AN  68
C     SEARCH FOR MEMBER ACTIVITIES AND *                                 AN  69
C     STORE DATA INTO OUTPUT VECTOR    *                                 AN  70
C     **********************************                                 AN  71
      DO 280 JJJ=1,MM                                                    AN  72
      I=NSORT(JJJ)                                                       AN  73
      CALL UNPAK (KK,15,I)                                               AN  74
      IF (KK.GE.0) GO TO 280                                             AN  75
      IF (NACTIV(4,I).NE.ICOMP(1,N)) GO TO 280                           AN  76
      IOUT(19)=NACTIV(4,I)                                               AN  77
      IOUT(20)=NACTIV(5,I)                                               AN  78
      IOUT(21)=NACTIV(6,I)                                               AN  79
      ITEM=NACTIV(9,I)                                                   AN  80
      IOUT(5)=NACTIV(2,I)                                                AN  81
      IF (ITEM.EQ.0) GO TO 280                                           AN  82
      IF (ITEM.GT.LEVEL) GO TO 280                                       AN  83
      CALL UNPAK (KK,13,I)                                               AN  84
      IF (KK.LT.0) GO TO 240                                             AN  85
      NUT=NO                                                             AN  86
      DO 220 J=7,9,2                                                     AN  87
  220 IOUT(J)=BLNK                                                       AN  88
      OUT(8)=BLANK                                                       AN  89
      CALL CLNDR (NACTIV(16,I),IOUT(10),OUT(11),IOUT(12))                AN  90
      CALL CLNDR (NACTIV(29,I),IOUT(13),OUT(14),IOUT(15))                AN  91
      CALL CLNDR (NACTIV(42,I),IOUT(16),OUT(17),IOUT(18))                AN  92
      DO 230 J=10,16,3                                                   AN  93
      CALL BTOD (IOUT(J))                                                AN  94
      CALL BTOD (IOUT(J+2))                                              AN  95
  230 CONTINUE                                                           AN  96
      GO TO 260                                                          AN  97
  240 DO 250 J=10,16,3                                                   AN  98
      OUT(J+1)=BLANK                                                     AN  99
      IOUT(J)=BLNK                                                       AN 100
  250 IOUT(J+2)=BLNK                                                     AN 101
      NUT=YES                                                            AN 102
      CALL CLNDR (NACTIV(42,I),IOUT(7),OUT(8),IOUT(9))                   AN 103
      CALL BTOD (IOUT(7))                                                AN 104
      CALL BTOD (IOUT(9))                                                AN 105
  260 WRITE (6,290) (IOUT(J),J=22,27),(IOUT(J),J=19,21),IOUT(5),(NACTIV( AN 106
     1J,I),J=55,66),NUT,IOUT(7),OUT(8),IOUT(9),IOUT(10),OUT(11),IOUT(12) AN 107
     2,IOUT(13),OUT(14),IOUT(15),IOUT(16),OUT(17),IOUT(18)               AN 108
      DO 270 J=22,27                                                     AN 109
  270 IOUT(J)=BLNK                                                       AN 110
      LINE=LINE+1                                                        AN 111
      IF (LINE.LT.56) GO TO 280                                          AN 112
      WRITE (6,300)                                                      AN 113
      NPAGE=NPAGE+1                                                      AN 114
      CALL HEDGEN (NPAGE)                                                AN 115
      WRITE (6,310)                                                      AN 116
      LINE=10                                                            AN 117
  280 CONTINUE                                                           AN 118
      RETURN                                                             AN 119
C                                                                        AN 120
  290 FORMAT (16X,6A2,I2,2I1,I6,2X,12A2,10X,A4,2X,4(2X,A2,A4,1X,A2))     AN 121
  300 FORMAT (1H1,42X,45HSCHEDULE ANALYSIS AND REVIEW PROCEDURE (SARP)// AN 122
     1)                                                                  AN 123
  310 FORMAT (37X,9HMILESTONE,26X,8HACTIVITY,4X,5HCOMPL,7X,26HESTIMATED  AN 124
     1COMPLETION DATES/12X,7HPROJECT,16X,3HNO.,7X,11HDESCRIPTION,10X,33H AN 125
     2      COMPLETE    DATE       BASE7X,4HPREV,8X,4HCURR//)            AN 126
      END                                                                AN 127-
      SUBROUTINE NPERT                                                   AO   1
C     NASA PERT REPORT                                                   AO   2
C     NPERT STORAGE AREAS *                                              AO   3
      INTEGER*2 KNT,I,J,ICNT,K,MM,KK,JJ,L,II                             AO   4
      COMMON MONS(12),NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15) AO   5
     1,NREP(15,5),NCPDAT(5,30)                                           AO   6
      INTEGER YES                                                        AO   7
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT                     AO   8
      EQUIVALENCE (NCOM(1),MAXACT)                                       AO   9
      INTEGER*2 MAXACT,MAXCMP,JJJ,KOUT                                   AO  10
      EQUIVALENCE (NSORT(1),KOUT(1))                                     AO  11
      INTEGER*2 NSORT                                                    AO  12
      COMMON /OUTPUT/ OUT(20),IOUT(20),KOUT(999)                         AO  13
      INTEGER*2 IOUT                                                     AO  14
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST,BLNK                    AO  15
      COMMON /CNSTNT/ KMON,LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME          AO  16
      INTEGER*2 LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME                     AO  17
      COMMON /MISC/ IFLAG,IQ,LINE,NUMSYS,NUMCMP                          AO  18
      INTEGER*2 IFLAG,IQ,M,LINE,NUMSYS,NUMCMP                            AO  19
      DIMENSION NSORT(999)                                               AO  20
      INTEGER*2 A,B,C,D,DAY,YR,BLNK                                      AO  21
      DATA ASTRSK/'****'/                                                AO  22
      KNT=1                                                              AO  23
      I=0                                                                AO  24
  110 I=I+1                                                              AO  25
      CALL UNPAK (J,15,I)                                                AO  26
      IF (J.GE.0) GO TO 110                                              AO  27
      ICNT=NACTIV(4,I)                                                   AO  28
      DO 120 J=1,15                                                      AO  29
      IF (NREP(J,4).EQ.0.AND.ICNT.EQ.J) GO TO 110                        AO  30
      IF (ICNT.LE.0.OR.ICNT.GT.NCOM(4)) GO TO 110                        AO  31
  120 CONTINUE                                                           AO  32
      NSORT(1)=I                                                         AO  33
      DO 130 NZERO=2,999                                                 AO  34
  130 NSORT(NZERO)=0                                                     AO  35
      K=I+1                                                              AO  36
      MM=K-1                                                             AO  37
      DO 200 I=K,MAXACT                                                  AO  38
      CALL UNPAK (J,15,I)                                                AO  39
      IF (J.GE.0) GO TO 200                                              AO  40
      ICNT=NACTIV(4,I)                                                   AO  41
      DO 140 JJ=1,15                                                     AO  42
      IF (NREP(JJ,4).EQ.0.AND.ICNT.EQ.JJ) GO TO 200                      AO  43
      IF (ICNT.LE.0.OR.ICNT.GT.NCOM(4)) GO TO 200                        AO  44
  140 CONTINUE                                                           AO  45
      MM=MM+1                                                            AO  46
      DO 190 J=1,MAXACT                                                  AO  47
      L=NSORT(J)                                                         AO  48
      IF (L.EQ.I) GO TO 200                                              AO  49
      IF ((L.LE.0).OR.(L.GT.999)) GO TO 190                              AO  50
      IF (NACTIV(2,I)-NACTIV(2,L)) 150,180,170                           AO  51
  150 II=MM                                                              AO  52
      M=MM-1                                                             AO  53
      DO 160 JJ=J,M                                                      AO  54
      NSORT(II)=NSORT(II-1)                                              AO  55
  160 II=II-1                                                            AO  56
      NSORT(J)=I                                                         AO  57
      GO TO 200                                                          AO  58
  170 L=MM                                                               AO  59
      NSORT(L)=I                                                         AO  60
      GO TO 190                                                          AO  61
  180 IF (NACTIV(1,I)-NACTIV(1,L)) 150,150,170                           AO  62
  190 CONTINUE                                                           AO  63
  200 CONTINUE                                                           AO  64
  210 NPAGE=1                                                            AO  65
      LINE=13                                                            AO  66
      WRITE (6,620)                                                      AO  67
      CALL HEDGEN (NPAGE)                                                AO  68
      CALL CLNDR (0,DAY,MON,YR)                                          AO  69
      GO TO (380,390,240,220,230), KNT                                   AO  70
  220 WRITE (6,660) DAY,MON,YR,DAY,MON,YR,KDAY,KMON,KYR                  AO  71
      GO TO 250                                                          AO  72
  230 WRITE (6,670) DAY,MON,YR,DAY,MON,YR,KDAY,KMON,KYR                  AO  73
      GO TO 400                                                          AO  74
  240 WRITE (6,650) DAY,MON,YR,DAY,MON,YR,KDAY,KMON,KYR                  AO  75
      NN=42                                                              AO  76
      GO TO 260                                                          AO  77
  250 NN=44                                                              AO  78
  260 II=0                                                               AO  79
  270 II=II+1                                                            AO  80
      CALL UNPAK (J,15,II)                                               AO  81
      IF (J.GE.0) GO TO 270                                              AO  82
      ICNT=NACTIV(4,II)                                                  AO  83
      DO 280 J=1,15                                                      AO  84
      IF (NREP(J,4).EQ.0.AND.ICNT.EQ.J) GO TO 270                        AO  85
      IF (ICNT.LE.0.OR.ICNT.GT.NCOM(4)) GO TO 270                        AO  86
  280 CONTINUE                                                           AO  87
      NSORT(1)=II                                                        AO  88
      K=II+1                                                             AO  89
      MM=K-1                                                             AO  90
      DO 370 II=K,MAXACT                                                 AO  91
      CALL UNPAK (JJ,15,II)                                              AO  92
      IF (JJ.GE.0) GO TO 370                                             AO  93
      ICNT=NACTIV(4,II)                                                  AO  94
      DO 290 JJ=1,15                                                     AO  95
      IF (NREP(JJ,4).EQ.0.AND.ICNT.EQ.JJ) GO TO 370                      AO  96
      IF (ICNT.LE.0.OR.ICNT.GT.NCOM(4)) GO TO 370                        AO  97
  290 CONTINUE                                                           AO  98
      MM=MM+1                                                            AO  99
      IOUT(1)=NACTIV(NN,II)                                              AO 100
      DO 360 J=1,MAXACT                                                  AO 101
      L=NSORT(J)                                                         AO 102
      IF (L.EQ.II) GO TO 370                                             AO 103
      IOUT(2)=NACTIV(NN,L)                                               AO 104
      IF (KNT.EQ.3) GO TO 310                                            AO 105
      GO TO 300                                                          AO 106
  300 IF (IOUT(1)-IOUT(2)) 320,360,340                                   AO 107
  310 IF (IOUT(1)-IOUT(2)) 320,350,340                                   AO 108
  320 KK=MM                                                              AO 109
      M=MM-1                                                             AO 110
      DO 330 JJ=J,M                                                      AO 111
      NSORT(KK)=NSORT(KK-1)                                              AO 112
  330 KK=KK-1                                                            AO 113
      NSORT(J)=II                                                        AO 114
      GO TO 370                                                          AO 115
  340 L=MM                                                               AO 116
      NSORT(L)=II                                                        AO 117
      GO TO 360                                                          AO 118
  350 IF (NACTIV(1,II)-NACTIV(1,L)) 320,320,340                          AO 119
  360 CONTINUE                                                           AO 120
  370 CONTINUE                                                           AO 121
      GO TO 430                                                          AO 122
  380 WRITE (6,630) DAY,MON,YR,DAY,MON,YR,KDAY,KMON,KYR                  AO 123
C                                                                        AO 124
C        CHANGES BY WOLF RESEARCH IN JUNE 1972                           AO 125
C                                                                        AO 126
C        THE CHANGES REGROUPED THE INFORMATION FOUND IN THE TWO          AO 127
C        PERT REPORTS 'BY SUCCESSOR EVENT' AND 'BY PATHS OF              AO 128
C        CRITICALITY' INTO CONTRACT NUMBER GROUPINGS AND                 AO 129
C        ADDED THE REPORTS 'BY SUCCESSOR EVENT AND CONTRACT              AO 130
C        NUMBER' AND 'BY PATHS OF CRITICALITY AND CONTRACT               AO 131
C        NUMBER' WITH SPACEING BETWEEN EACH DIFFERENT CONTRACT           AO 132
C                                                                        AO 133
      GO TO 430                                                          AO 134
  390 WRITE (6,640) DAY,MON,YR,DAY,MON,YR,KDAY,KMON,KYR                  AO 135
  400 NI=MM                                                              AO 136
  410 IFLAG=0                                                            AO 137
      DO 420 I=1,NI                                                      AO 138
      IF (I.EQ.NI) GO TO 420                                             AO 139
      JI=NSORT(I)                                                        AO 140
      KI=NSORT(I+1)                                                      AO 141
      IF (NACTIV(4,JI).LE.NACTIV(4,KI)) GO TO 420                        AO 142
      IFLAG=1                                                            AO 143
      ITEMP=NSORT(I)                                                     AO 144
      NSORT(I)=NSORT(I+1)                                                AO 145
      NSORT(I+1)=ITEMP                                                   AO 146
  420 CONTINUE                                                           AO 147
      NI=NI-1                                                            AO 148
      IF (IFLAG.EQ.1) GO TO 410                                          AO 149
  430 DO 590 JJJ=1,MM                                                    AO 150
      I=NSORT(JJJ)                                                       AO 151
C     CHECK FOR GARBAGE IN SORT AREA BY VERIFYING CONTRACT NUMBER        AO 152
      IF ((NACTIV(4,I).GT.NCOM(4)).OR.(NACTIV(4,I).LE.0)) GO TO 590      AO 153
      IOUT(1)=NACTIV(41,I)                                               AO 154
      IOUT(13)=NACTIV(42,I)                                              AO 155
      IOUT(5)=NACTIV(43,I)                                               AO 156
      IOUT(12)=NACTIV(44,I)                                              AO 157
C     ***************************************************                AO 158
C     TEST FOR ACTIVITY COMPLETE AND FILL OUTPUT VECTOR *                AO 159
C     ***************************************************                AO 160
      CALL CLNDR (IOUT(5),IOUT(5),OUT(6),IOUT(7))                        AO 161
      CALL BTOD (IOUT(5))                                                AO 162
      CALL BTOD (IOUT(7))                                                AO 163
      CALL CLNDR (IOUT(13),IOUT(2),OUT(3),IOUT(4))                       AO 164
      CALL BTOD (IOUT(2))                                                AO 165
      CALL BTOD (IOUT(4))                                                AO 166
      OUT(1)=IOUT(1)                                                     AO 167
      OUT(12)=IOUT(12)                                                   AO 168
      OUT(13)=IOUT(13)                                                   AO 169
      OUT(1)=OUT(1)/10.0                                                 AO 170
      OUT(12)=OUT(12)/10.0                                               AO 171
      OUT(13)=OUT(13)/10.0                                               AO 172
      CALL UNPAK (JJ,13,I)                                               AO 173
      IF (JJ.GE.0) GO TO 450                                             AO 174
      NUT=YES                                                            AO 175
      DO 440 K=2,4,2                                                     AO 176
      IOUT(K+7)=IOUT(K)                                                  AO 177
      IOUT(K)=BLNK                                                       AO 178
  440 CONTINUE                                                           AO 179
      OUT(10)=OUT(3)                                                     AO 180
      OUT(3)=BLANK                                                       AO 181
      GO TO 480                                                          AO 182
  450 NUT=NO                                                             AO 183
      CALL UNPAK (JJ,10,I)                                               AO 184
      IF (JJ.GE.0) GO TO 460                                             AO 185
      II=NACTIV(4,I)                                                     AO 186
      IF (NTRACT(3,II).EQ.0) GO TO 460                                   AO 187
      CALL CLNDR (NTRACT(3,II),IOUT(9),OUT(10),IOUT(11))                 AO 188
      CALL BTOD (IOUT(9))                                                AO 189
      CALL BTOD (IOUT(11))                                               AO 190
      GO TO 480                                                          AO 191
  460 DO 470 K=9,11,2                                                    AO 192
  470 IOUT(K)=BLNK                                                       AO 193
      OUT(10)=BLANK                                                      AO 194
  480 IOUT(14)=NACTIV(4,I)                                               AO 195
      IOUT(15)=NACTIV(5,I)                                               AO 196
      IOUT(16)=NACTIV(6,I)                                               AO 197
      CALL UNPAK (JJ,5,I)                                                AO 198
      IF (JJ.GE.0) GO TO 510                                             AO 199
      DO 490 K=1,50                                                      AO 200
      IF (IOUT(14).EQ.NCOMP(1,K).AND.IOUT(15).EQ.NCOMP(2,K).AND.IOUT(16) AO 201
     1.EQ.NCOMP(3,K)) GO TO 500                                          AO 202
  490 CONTINUE                                                           AO 203
  500 IF (NCOMP(10,K).EQ.0) GO TO 510                                    AO 204
      CALL CLNDR (NCOMP(10,K),IOUT(9),OUT(10),IOUT(11))                  AO 205
      CALL BTOD (IOUT(9))                                                AO 206
      CALL BTOD (IOUT(11))                                               AO 207
  510 STAR=BLANK                                                         AO 208
      IF (NACTIV(52,I).NE.0) STAR=ASTRSK                                 AO 209
      WRITE (6,680) IOUT(14),IOUT(15),IOUT(16),NACTIV(1,I),IOUT(14),IOUT AO 210
     1(15),IOUT(16),NACTIV(2,I),(NACTIV(K,I),K=55,66),OUT(1),IOUT(2),OUT AO 211
     2(3),IOUT(4),IOUT(5),OUT(6),IOUT(7),NUT,IOUT(9),OUT(10),IOUT(11),OU AO 212
     3T(12),OUT(13),STAR                                                 AO 213
      GO TO (530,520,530,530,520), KNT                                   AO 214
C                                                                        AO 215
C        WOLF RESEARCH CODE TO SKIP A LINE BETWEEN EACH DIFFERENT        AO 216
C        CONTRACT NUMBER OF THE CONTRACT SORTED REPORTS                  AO 217
C                                                                        AO 218
  520 LL=JJJ+1                                                           AO 219
      IL=NSORT(LL)                                                       AO 220
      IF (NACTIV(4,I).EQ.NACTIV(4,IL)) GO TO 530                         AO 221
      PRINT 610                                                          AO 222
      LINE=LINE+1                                                        AO 223
  530 LINE=LINE+1                                                        AO 224
      IF (LINE.LT.56) GO TO 590                                          AO 225
      IF (JJJ.EQ.MM) GO TO 590                                           AO 226
      LINE=13                                                            AO 227
      NPAGE=NPAGE+1                                                      AO 228
      WRITE (6,620)                                                      AO 229
      CALL HEDGEN (NPAGE)                                                AO 230
      GO TO (560,540,570,580,550), KNT                                   AO 231
  540 WRITE (6,640) DAY,MON,YR,DAY,MON,YR,KDAY,KMON,KYR                  AO 232
      GO TO 590                                                          AO 233
  550 WRITE (6,670) DAY,MON,YR,DAY,MON,YR,KDAY,KMON,KYR                  AO 234
      GO TO 590                                                          AO 235
  560 WRITE (6,630) DAY,MON,YR,DAY,MON,YR,KDAY,KMON,KYR                  AO 236
      GO TO 590                                                          AO 237
  570 WRITE (6,650) DAY,MON,YR,DAY,MON,YR,KDAY,KMON,KYR                  AO 238
      GO TO 590                                                          AO 239
  580 WRITE (6,660) DAY,MON,YR,DAY,MON,YR,KDAY,KMON,KYR                  AO 240
  590 CONTINUE                                                           AO 241
      KNT=KNT+1                                                          AO 242
      IF (KNT.EQ.6) GO TO 600                                            AO 243
      GO TO 210                                                          AO 244
  600 RETURN                                                             AO 245
C                                                                        AO 246
  610 FORMAT (1H )                                                       AO 247
  620 FORMAT (1H1,57X,16HNASA PERT REPORT//)                             AO 248
  630 FORMAT (13X,22H BY SUCCESSOR EVENT   ,40X,18HBEGINNING DATE OF 10H AO 249
     1NETWORK IS,I3,A4,I3/13X,22HNETWORK    PROJECT OOO,34X,9HFIRST RUN, AO 250
     2I3,A4,I3,11X,7HUPDATED,I3,1XA3,I3//56X,51HACTIVITY  EXPECTED    AL AO 251
     3LOWED   ACTIVITY  SCHLD/ACT10X,9HTIME FROM/4X,34HPRED EVENT  SUCC  AO 252
     4EVENT   ACTIVITY 11HDESCRIPTION,9X,4HTIME,6X,4HDATE,7X,4HDATE,5X,8 AO 253
     5HCOMPLETE,4X,4HDATE,6X,16HSLACK  BEGINNING//)                      AO 254
  640 FORMAT (3X,38HBY SUCCESSOR EVENT AND CONTRACT NUMBER,33X,18HBEGINN AO 255
     1ING DATE OF,10HNETWORK IS,I3,A4,I3/13X,22HNETWORK    PROJECT 000,3 AO 256
     24X,9HFIRST RUN,I3,A4,I3,11X,7HUPDATED,I3,1XA3,I3//56X,51HACTIVITY  AO 257
     3 EXPECTED    ALLOWED   ACTIVITY  SCHLD/ACT10X,9HTIME FROM/4X,34HPR AO 258
     4ED EVENT  SUCC EVENT   ACTIVITY 11HDESCRIPTION,9X,4HTIME,6X,4HDATE AO 259
     5,7X,4HDATE,5X,8HCOMPLETE,4X,4HDATE,6X,16HSLACK  BEGINNING//)       AO 260
  650 FORMAT (13X,22H  BY EXPECTED DATE    ,40X,18HBEGINNING DATE OF 10H AO 261
     1NETWORK IS,I3,A4,I3/13X,22HNETWORK    PROJECT OOO,34X,9HFIRST RUN, AO 262
     2I3,A4,I3,11X,7HUPDATED,I3,1XA3,I3//56X,51HACTIVITY  EXPECTED    AL AO 263
     3LOWED   ACTIVITY  SCHLD/ACT10X,9HTIME FROM/4X,34HPRED EVENT  SUCC  AO 264
     4EVENT   ACTIVITY 11HDESCRIPTION,9X,4HTIME,6X,4HDATE,7X,4HDATE,5X,8 AO 265
     5HCOMPLETE,4X,4HDATE,6X,16HSLACK  BEGINNING//)                      AO 266
  660 FORMAT (12X,23HBY PATHS OF CRITICALITY,40X,18HBEGINNING DATE OF 10 AO 267
     1HNETWORK IS,I3,A4,I3/13X,22HNETWORK    PROJECT OOO,34X,9HFIRST RUN AO 268
     2,I3,A4,I3,11X,7HUPDATED,I3,1XA3,I3//56X,51HACTIVITY  EXPECTED    A AO 269
     3LLOWED   ACTIVITY  SCHLD/ACT10X,9HTIME FROM/4X,34HPRED EVENT  SUCC AO 270
     4 EVENT   ACTIVITY 11HDESCRIPTION,9X,4HTIME,6X,4HDATE,7X,4HDATE,5X, AO 271
     58HCOMPLETE,4X,4HDATE,6X,16HSLACK  BEGINNING//)                     AO 272
  670 FORMAT (1X,43HBY PATHS OF CRITICALITY AND CONTRACT NUMBER,30X,18HB AO 273
     1EGINNING DATE OF ,10HNETWORK IS,I3,A4,I3/13X,22HNETWORK    PROJECT AO 274
     2 000,34X,9HFIRST RUN,I3,A4,I3,11X,7HUPDATED,I3,1XA3,I3//56X,51HACT AO 275
     3IVITY  EXPECTED    ALLOWED   ACTIVITY  SCHLD/ACT10X,9HTIME FROM/4X AO 276
     4,34HPRED EVENT  SUCC EVENT   ACTIVITY 11HDESCRIPTION,9X,4HTIME,6X, AO 277
     54HDATE,7X,4HDATE,5X,8HCOMPLETE,4X,4HDATE,6X,16HSLACK  BEGINNING//) AO 278
  680 FORMAT (3X,I2,2I1,I4,4X,I2,2I1,I4,5X,12A2,F10.1,2X,2(2X,A2,A4,1X,A AO 279
     12),3X,A4,5X,A2,A4,1X,A2,F8.1,F9.1,1X,A1)                           AO 280
      END                                                                AO 281-
      SUBROUTINE TCHNAR                                                  AP   1
C     TECHNICAL NARRATIVE                                                AP   2
C     TCHNAR STORAGE AREAS *                                             AP   3
      COMMON MONS(12),NCOM(22),NACTIV(66,999),ICOMP(48,50),NTRACT(13,15) AP   4
     1,NREP(15,5),NCPDAT(5,30),NDATE(12)                                 AP   5
      INTEGER*2 NCOM,NACTIV,ICOMP,NTRACT,NREP,NCPDAT,NDATE               AP   6
      COMMON /CNSTNT/ KMON,LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME          AP   7
      INTEGER*2 I                                                        AP   8
      INTEGER YES                                                        AP   9
      INTEGER*2 ITEM,NYR,K                                               AP  10
      INTEGER*2 J                                                        AP  11
      INTEGER*2 LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME                     AP  12
      COMMON /OUTPUT/ OUT(20),IOUT1(14,25),IOUT2(14,25),IOUT3(14,25)     AP  13
      INTEGER*2 IOUT1,IOUT2,IOUT3                                        AP  14
      COMMON /MISC/ IFLAG,IQ,LINE,NUMSYS,NUMCMP                          AP  15
      INTEGER*2 IFLAG,IQ,LINE,NUMSYS,NUMCMP                              AP  16
      EQUIVALENCE (NCOM(1),MAXACT), (NCOM(8),KAY)                        AP  17
      INTEGER*2 KAY,MAXACT,CAL1,CAL3                                     AP  18
      COMMON /BCDOUT/ HEAD(6,4),YES,NO,BLANK,AST                         AP  19
      WRITE (6,230)                                                      AP  20
      CALL HEDGEN (1)                                                    AP  21
      WRITE (6,240) (ICOMP(I,N),I=1,9)                                   AP  22
      NCTR1=0                                                            AP  23
      NCTR2=0                                                            AP  24
      NCTR3=0                                                            AP  25
      NPAGE=0                                                            AP  26
      DO 140 I=1,MAXACT                                                  AP  27
      CALL UNPAK (J,15,I)                                                AP  28
      IF (J.GE.0) GO TO 140                                              AP  29
      IF (NACTIV(4,I).NE.ICOMP(1,N)) GO TO 140                           AP  30
      IF (NACTIV(9,I).GT.LEVEL) GO TO 130                                AP  31
      CALL UNPAK (J,13,I)                                                AP  32
      IF (J.GE.0) GO TO 110                                              AP  33
C     *******************************                                    AP  34
C     FETCH COMPLETED-ACTIVITY DATA *                                    AP  35
C     *******************************                                    AP  36
      CALL UNPAK (J,6,I)                                                 AP  37
      IF (J.GE.0) GO TO 130                                              AP  38
      NCTR1=NCTR1+1                                                      AP  39
      IOUT1(1,NCTR1)=NACTIV(1,I)                                         AP  40
      IOUT1(2,NCTR1)=NACTIV(2,I)                                         AP  41
      IOUT1(3,NCTR1)=NACTIV(55,I)                                        AP  42
      IOUT1(4,NCTR1)=NACTIV(56,I)                                        AP  43
      IOUT1(5,NCTR1)=NACTIV(57,I)                                        AP  44
      IOUT1(6,NCTR1)=NACTIV(58,I)                                        AP  45
      IOUT1(7,NCTR1)=NACTIV(59,I)                                        AP  46
      IOUT1(8,NCTR1)=NACTIV(60,I)                                        AP  47
      IOUT1(9,NCTR1)=NACTIV(61,I)                                        AP  48
      IOUT1(10,NCTR1)=NACTIV(62,I)                                       AP  49
      IOUT1(11,NCTR1)=NACTIV(63,I)                                       AP  50
      IOUT1(12,NCTR1)=NACTIV(64,I)                                       AP  51
      IOUT1(13,NCTR1)=NACTIV(65,I)                                       AP  52
      IOUT1(14,NCTR1)=NACTIV(66,I)                                       AP  53
      GO TO 130                                                          AP  54
C     ******************************************                         AP  55
C     FETCH NEXT MONTH COMPLETED-ACTIVITY DATA *                         AP  56
C     ******************************************                         AP  57
  110 ITEM=NACTIV(42,I)                                                  AP  58
      K=NCOM(21)+1                                                       AP  59
      NYR=NCOM(20)                                                       AP  60
      IF (K.LE.12) GO TO 120                                             AP  61
      K=1                                                                AP  62
      NYR=NCOM(20)+1                                                     AP  63
  120 CALL CDATE (NDATE(K),MONS(K),NYR,K)                                AP  64
      IF (ITEM.GT.K) GO TO 130                                           AP  65
      NCTR2=NCTR2+1                                                      AP  66
      IOUT2(1,NCTR2)=NACTIV(1,I)                                         AP  67
      IOUT2(2,NCTR2)=NACTIV(2,I)                                         AP  68
      IOUT2(3,NCTR2)=NACTIV(55,I)                                        AP  69
      IOUT2(4,NCTR2)=NACTIV(56,I)                                        AP  70
      IOUT2(5,NCTR2)=NACTIV(57,I)                                        AP  71
      IOUT2(6,NCTR2)=NACTIV(58,I)                                        AP  72
      IOUT2(7,NCTR2)=NACTIV(59,I)                                        AP  73
      IOUT2(8,NCTR2)=NACTIV(60,I)                                        AP  74
      IOUT2(9,NCTR2)=NACTIV(61,I)                                        AP  75
      IOUT2(10,NCTR2)=NACTIV(62,I)                                       AP  76
      IOUT2(11,NCTR2)=NACTIV(63,I)                                       AP  77
      IOUT2(12,NCTR2)=NACTIV(64,I)                                       AP  78
      IOUT2(13,NCTR2)=NACTIV(65,I)                                       AP  79
      IOUT2(14,NCTR2)=NACTIV(66,I)                                       AP  80
C     *************************                                          AP  81
C     FETCT TEST FAILURE DATA *                                          AP  82
C     *************************                                          AP  83
  130 CALL UNPAK (J,8,I)                                                 AP  84
      IF (J.GE.0) GO TO 140                                              AP  85
      NCTR3=NCTR3+1                                                      AP  86
      IOUT3(1,NCTR3)=NACTIV(1,I)                                         AP  87
      IOUT3(2,NCTR3)=NACTIV(2,I)                                         AP  88
      IOUT3(3,NCTR3)=NACTIV(55,I)                                        AP  89
      IOUT3(4,NCTR3)=NACTIV(56,I)                                        AP  90
      IOUT3(5,NCTR3)=NACTIV(57,I)                                        AP  91
      IOUT3(6,NCTR3)=NACTIV(58,I)                                        AP  92
      IOUT3(7,NCTR3)=NACTIV(59,I)                                        AP  93
      IOUT3(8,NCTR3)=NACTIV(60,I)                                        AP  94
      IOUT3(9,NCTR3)=NACTIV(61,I)                                        AP  95
      IOUT3(10,NCTR3)=NACTIV(62,I)                                       AP  96
      IOUT3(11,NCTR3)=NACTIV(63,I)                                       AP  97
      IOUT3(12,NCTR3)=NACTIV(64,I)                                       AP  98
      IOUT3(13,NCTR3)=NACTIV(65,I)                                       AP  99
      IOUT3(14,NCTR3)=NACTIV(66,I)                                       AP 100
  140 CONTINUE                                                           AP 101
      WRITE (6,250)                                                      AP 102
      LINE=13                                                            AP 103
      IF (NCTR1.EQ.0) GO TO 170                                          AP 104
      DO 150 J=1,NCTR1                                                   AP 105
      WRITE (6,280) (IOUT1(I,J),I=1,14)                                  AP 106
      LINE=LINE+1                                                        AP 107
      IF (LINE.LT.56) GO TO 150                                          AP 108
      NPAGE=NPAGE+1                                                      AP 109
      WRITE (6,230)                                                      AP 110
      CALL HEDGEN (NPAGE)                                                AP 111
      WRITE (6,300)                                                      AP 112
      LINE=7                                                             AP 113
  150 CONTINUE                                                           AP 114
C       ********                                                         AP 115
C      ADD OUT OF FUNDS WARNING IF CONTRACT FROZEN OR WILL BE            AP 116
      IF (NTRACT(7,M).EQ.1) GO TO 160                                    AP 117
      IF ((11*NTRACT(10,M)/7).LT.NTRACT(4,M)) GO TO 160                  AP 118
      WRITE (6,220)                                                      AP 119
  160 CONTINUE                                                           AP 120
C       ********                                                         AP 121
  170 WRITE (6,260)                                                      AP 122
      LINE=LINE+3                                                        AP 123
      IF (NCTR2.EQ.0) GO TO 190                                          AP 124
      DO 180 J=1,NCTR2                                                   AP 125
      WRITE (6,280) (IOUT2(I,J),I=1,14)                                  AP 126
      LINE=LINE+1                                                        AP 127
      IF (LINE.LT.56) GO TO 180                                          AP 128
      NPAGE=NPAGE+1                                                      AP 129
      WRITE (6,230)                                                      AP 130
      CALL HEDGEN (NPAGE)                                                AP 131
      WRITE (6,300)                                                      AP 132
      LINE=7                                                             AP 133
  180 CONTINUE                                                           AP 134
  190 WRITE (6,270)                                                      AP 135
      LINE=LINE+3                                                        AP 136
      IF (NCTR3.EQ.0) GO TO 210                                          AP 137
      DO 200 J=1,NCTR3                                                   AP 138
      WRITE (6,280) (IOUT3(I,J),I=1,14)                                  AP 139
      LINE=LINE+1                                                        AP 140
      IF (LINE.LT.56) GO TO 200                                          AP 141
      NPAGE=NPAGE+1                                                      AP 142
      WRITE (6,230)                                                      AP 143
      CALL HEDGEN (NPAGE)                                                AP 144
      WRITE (6,300)                                                      AP 145
  200 CONTINUE                                                           AP 146
  210 CALL CLNDR (ICOMP(37,N),CAL1,CAL2,CAL3)                            AP 147
      WRITE (6,290) CAL1,CAL2,CAL3                                       AP 148
      RETURN                                                             AP 149
C                                                                        AP 150
  220 FORMAT (//,5X,'*** FUND LIMITATION PREVENTS FURTHER WORK,    IF FU AP 151
     1NDS PROVIDED BY START OF MONTH,THEN WE EXPECT')                    AP 152
  230 FORMAT (1H1,55X,19HTECHNICAL NARRATIVE//)                          AP 153
  240 FORMAT (46X,9HCOMPONENT/44X,14HIDENTIFICATION,9X,11HDESCRIPTION/I4 AP 154
     19,2I2,9X,6A2)                                                      AP 155
  250 FORMAT (/1H0/1H0/1H0,49X,31HACTIVITIES COMPLETED LAST MONTH/35X,10 AP 156
     1HPRED EVENT,3X,10HSUCC EVENT/)                                     AP 157
  260 FORMAT (/1H0/1H0/1H0,42X,46HACTIVITIES EXPECTED TO BE COMPLETED NE AP 158
     1XT MONTH/35X,10HPRED EVENT,3X,10HSUCC EVENT/)                      AP 159
  270 FORMAT (/1H0/1H0/1H057X,13HTEST FAILURES/35X,10HPRED EVENT,3X,10HS AP 160
     1UCC EVENT/)                                                        AP 161
  280 FORMAT (34X,I6,7X,I6,5X,12A2)                                      AP 162
  290 FORMAT (/1H0/1H0/1H0,7X,24HEXPECTED COMPLETION DATE,10X,I6,A4,I3)  AP 163
  300 FORMAT (1H0)                                                       AP 164
      END                                                                AP 165-
      SUBROUTINE HEDGEN (I)                                              AQ   1
C     GENERATE PLAYER,DATE,LEVEL AND PAGE HEADINGS                       AQ   2
C     HEDGEN STORAGE AREAS *                                             AQ   3
      COMMON MONS(12),NCOM(22)                                           AQ   4
      INTEGER*2 NCOM                                                     AQ   5
      EQUIVALENCE (NCOM(6),MANNO)                                        AQ   6
      INTEGER*2 MANNO                                                    AQ   7
      COMMON /CNSTNT/ KMON,LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME          AQ   8
      INTEGER*2 LEVEL,N,M,MONO,KDAY,KYR,BMAXTE,NTIME                     AQ   9
      WRITE (6,110) MANNO,KDAY,KMON,KYR                                  AQ  10
      WRITE (6,120) LEVEL                                                AQ  11
      WRITE (6,130) I                                                    AQ  12
      RETURN                                                             AQ  13
C                                                                        AQ  14
  110 FORMAT (56X,6HPLAYER,I14/56X,4HDATE,I9,1X,A3,I3)                   AQ  15
  120 FORMAT (56X,5HLEVEL,I15)                                           AQ  16
  130 FORMAT (56X,4HPAGE,I16//)                                          AQ  17
      END                                                                AQ  18-
      SUBROUTINE CLNDR (WKS,DAY,MON,YR)                                  AR   1
C     CLNDR STORAGE AREAS *                                              AR   2
      COMMON MONS(12),NCOM(22)                                           AR   3
      INTEGER*2 NCOM                                                     AR   4
      EQUIVALENCE (NCOM(10),START), (NCOM(11),STRTYR)                    AR   5
      INTEGER*2 START,STRTYR                                             AR   6
      INTEGER TBL                                                        AR   7
      INTEGER*2 WKS,DAY,YR,REM,CUM,I,IYR                                 AR   8
C     ****************************************                           AR   9
C     PROGRAM TAKES INPUT (WKS) AND CONVERTS *                           AR  10
C     IT TO CALENDAR FORMAT (DAY,MON,YR).    *                           AR  11
C     STRTYR = YEAR IN WHICH PROJECT STARTS. *                           AR  12
C     START = WEEKS BETWEEN 1 JAN OF STRTYR  *                           AR  13
C             AND START DATE OF PROJECT.     *                           AR  14
C     ****************************************                           AR  15
      DIMENSION TBL(13,2)                                                AR  16
      DATA TBL(1,1),TBL(2,1),TBL(3,1),TBL(4,1),TBL(5,1),TBL(6,1),TBL(7,1 AR  17
     1),TBL(8,1),TBL(9,1),TBL(10,1),TBL(11,1),TBL(12,1),TBL(13,1),TBL(1, AR  18
     22),TBL(2,2),TBL(3,2),TBL(4,2),TBL(5,2),TBL(6,2),TBL(7,2),TBL(8,2), AR  19
     3TBL(9,2),TBL(10,2),TBL(11,2),TBL(12,2),TBL(13,2)/' JAN',' FEB',' M AR  20
     4AR',' APR',' MAY',' JUN',' JUL',' AUG',' SEP',' OCT',' NOV',' DEC' AR  21
     5,0,443,400,443,429,443,429,443,443,429,443,429,443,0/              AR  22
C     CORRECTION FOR DATES PRIOR TO STARTYR                              AR  23
      IYR=0                                                              AR  24
  110 IF ((WKS+START).GE.0) GO TO 120                                    AR  25
      IYR=IYR-1                                                          AR  26
      WKS=WKS+5217                                                       AR  27
      GO TO 110                                                          AR  28
  120 CONTINUE                                                           AR  29
      NOW=10*(WKS+START)                                                 AR  30
      REM=MOD(NOW,5217)                                                  AR  31
      IF (REM.EQ.0) REM=1                                                AR  32
      CUM=0                                                              AR  33
      DO 130 I=1,13                                                      AR  34
      IF (CUM.GE.REM) GO TO 140                                          AR  35
      CUM=CUM+TBL(I,2)                                                   AR  36
  130 CONTINUE                                                           AR  37
  140 YR=IYR+STRTYR+NOW/5217                                             AR  38
      MON=TBL(I-1,1)                                                     AR  39
      DAY=(7*(REM-(CUM-TBL(I-1,2)))+93)/100                              AR  40
      RETURN                                                             AR  41
      END                                                                AR  42-
      SUBROUTINE CDATE (IN1,IN2,IN3,NDT)                                 AS   1
      DIMENSION NTCON(12)                                                AS   2
      INTEGER*2 NTCON,IN1,IN3,NDT                                        AS   3
      DATA NTCON/0,443,843,1286,1715,2158,2587,3030,3473,3902,4345,4774/ AS   4
      COMMON MONS(12),NCOM(22),NACTIV(66,999),NCOMP(48,50),NTRACT(13,15) AS   5
     1,NREP(15,5),NCPDAT(5,30)                                           AS   6
      INTEGER*2 NCOM,NACTIV,NCOMP,NTRACT,NREP,NCPDAT                     AS   7
      DO 110 I=1,12                                                      AS   8
      IF (IN2.NE.MONS(I)) GO TO 110                                      AS   9
      NDT=(((100*IN1)/7+NTCON(I)+5217*(IN3-NCOM(11))-10*NCOM(10))+5)/10  AS  10
      RETURN                                                             AS  11
  110 CONTINUE                                                           AS  12
      WRITE (6,120) IN2                                                  AS  13
      STOP                                                               AS  14
C                                                                        AS  15
  120 FORMAT (26H1CDATE ERROR STOP.  IN2 = A4)                           AS  16
      END                                                                AS  17-
      SUBROUTINE BTOD (IN)                                               AT   1
      DIMENSION BTD(100)                                                 AT   2
      INTEGER*2 BTD,IN,I                                                 AT   3
      DATA BTD/' 0',' 1',' 2',' 3',' 4',' 5',' 6',' 7',' 8',' 9','10','1 AT   4
     11','12','13','14','15','16','17','18','19','20','21','22','23','24 AT   5
     2','25','26','27','28','29','30','31','32','33','34','35','36','37' AT   6
     3,'38','39','40','41','42','43','44','45','46','47','48','49','50', AT   7
     4'51','52','53','54','55','56','57','58','59','60','61','62','63',' AT   8
     564','65','66','67','68','69','70','71','72','73','74','75','76','7 AT   9
     67','78','79','80','81','82','83','84','85','86','87','88','89','90 AT  10
     7','91','92','93','94','95','96','97','98','99'/                    AT  11
      I=IN+1                                                             AT  12
      IN=BTD(I)                                                          AT  13
      RETURN                                                             AT  14
      END                                                                AT  15-
      SUBROUTINE PACK (K,N,M)                                            AU   1
C      PACK SETS BIT 'N' OF NACTIV(54,'M') TO 'K'                        AU   2
C      K AN N ARE I*4,M IS I*2                                           AU   3
C      BITS NUMBERED      1 TO 16 WHERE 16 IS LEAST SIGNIFICANT          AU   4
C                                                                        AU   5
      COMMON MONS(12),NCOM(22),NACTIV(66,999)                            AU   6
      INTEGER*2 NCOM,NACTIV,IB,J,L,M                                     AU   7
      J=NACTIV(54,M)                                                     AU   8
C      FIRST DETERMINE IF BIT 'N' IS ALREADY SET TO 'K'                  AU   9
      L=17-N                                                             AU  10
      DO 110 JL=1,L                                                      AU  11
      JK=J/2                                                             AU  12
      IB=J-2*JK                                                          AU  13
  110 J=JK                                                               AU  14
C     DETERMINE CHANGE REQUIRED IF ANY                                   AU  15
      JB=IB-K                                                            AU  16
      L=L-1                                                              AU  17
      J=2**L                                                             AU  18
      IF (JB) 130,140,120                                                AU  19
  120 J=-J                                                               AU  20
  130 NACTIV(54,M)=NACTIV(54,M)+J                                        AU  21
  140 RETURN                                                             AU  22
      END                                                                AU  23-
      SUBROUTINE UNPAK (K,N,M)                                           AV   1
C      UNPAK TESTS BIT 'N' OF NACTIV(54,'M')                             AV   2
C      RETURNS -1 IN 'K' IF BIT IS SET, 0 IF BIT IS 0                    AV   3
C     K AND M ARE I*2, N IS I*4 LENGTH                                   AV   4
      COMMON MONS(12),NCOM(22),NACTIV(66,999)                            AV   5
      DIMENSION IB(16)                                                   AV   6
      INTEGER*2 NCOM,NACTIV,IB,J,K,L,M,JK,JL                             AV   7
C      DETERMINE VALUE OF BITS BY 'EVEN OR ODD' TEST                     AV   8
      J=NACTIV(54,M)                                                     AV   9
      DO 110 JL=1,16                                                     AV  10
      L=17-JL                                                            AV  11
      IB(L)=-1                                                           AV  12
      JK=J/2                                                             AV  13
      IF (JK*2.EQ.J) IB(L)=0                                             AV  14
  110 J=JK                                                               AV  15
C      ARRAY IB NOW HAS ALL VALUES OF BITS,SELECT REQUESTED VALUE AND RE AV  16
      K=IB(N)                                                            AV  17
      RETURN                                                             AV  18
      END                                                                AV  19-
